Skip to content

Commit

Permalink
Add support for {Date,Time,TimeZone}/show (#2493)
Browse files Browse the repository at this point in the history 
… as standardized in dhall-lang/dhall-lang#1328
  • Loading branch information
@Gabriella439
Gabriella439 authored Apr 3, 2023
1 parent 90a674f commit 3aadd57
Show file tree
Hide file tree
Showing 15 changed files with 193 additions and 5 deletions.
3 changes: 3 additions & 0 deletions dhall-bash/src/Dhall/Bash.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -319,10 +319,13 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
go e@(TextShow {}) = Left (UnsupportedStatement e)
go e@(Date ) = Left (UnsupportedStatement e)
go e@(DateLiteral {}) = Left (UnsupportedStatement e)
go e@(DateShow ) = Left (UnsupportedStatement e)
go e@(Time ) = Left (UnsupportedStatement e)
go e@(TimeLiteral {}) = Left (UnsupportedStatement e)
go e@(TimeShow ) = Left (UnsupportedStatement e)
go e@(TimeZone ) = Left (UnsupportedStatement e)
go e@(TimeZoneLiteral {}) = Left (UnsupportedStatement e)
go e@(TimeZoneShow ) = Left (UnsupportedStatement e)
go e@(List ) = Left (UnsupportedStatement e)
go e@(ListAppend {}) = Left (UnsupportedStatement e)
go e@(ListBuild ) = Left (UnsupportedStatement e)
Expand Down
9 changes: 9 additions & 0 deletions dhall-json/src/Dhall/JSON.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -898,18 +898,27 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
Core.DateLiteral d ->
Core.DateLiteral d

Core.DateShow ->
Core.DateShow

Core.Time ->
Core.Time

Core.TimeLiteral t p ->
Core.TimeLiteral t p

Core.TimeShow ->
Core.TimeShow

Core.TimeZone ->
Core.TimeZone

Core.TimeZoneLiteral z ->
Core.TimeZoneLiteral z

Core.TimeZoneShow ->
Core.TimeZoneShow

Core.List ->
Core.List

Expand Down
8 changes: 8 additions & 0 deletions dhall-nix/src/Dhall/Nix.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -609,6 +609,14 @@ dhallToNix e =
loop DateLiteral{} = undefined
loop TimeLiteral{} = undefined
loop TimeZoneLiteral{} = undefined
-- We currently model `Date`/`Time`/`TimeZone` literals as strings in Nix,
-- so the corresponding show functions are the identity function
loop DateShow =
return ("date" ==> "date")
loop TimeShow =
return ("time" ==> "time")
loop TimeZoneShow =
return ("timeZone" ==> "timeZone")
loop (Record _) = return untranslatable
loop (RecordLit a) = do
a' <- traverse (loop . Dhall.Core.recordFieldValue) a
Expand Down
2 changes: 1 addition & 1 deletion dhall/dhall-lang
Submodule dhall-lang updated 25 files
+5 −0 Prelude/Date/package.dhall
+15 −0 Prelude/Date/show.dhall
+0 −37 Prelude/List/mapMaybe.dhall
+0 −3 Prelude/List/mapWithIndex
+0 −41 Prelude/List/mapWithIndex.dhall
+0 −8 Prelude/List/package.dhall
+0 −56 Prelude/Map/mapMaybe.dhall
+0 −4 Prelude/Map/package.dhall
+5 −0 Prelude/Time/package.dhall
+15 −0 Prelude/Time/show.dhall
+5 −0 Prelude/TimeZone/package.dhall
+15 −0 Prelude/TimeZone/show.dhall
+18 −6 Prelude/package.dhall
+22 −0 docs/howtos/Cheatsheet.md
+113 −0 docs/references/Built-in-types.md
+12 −0 standard/Parser.hs
+12 −0 standard/alpha-normalization.md
+59 −0 standard/beta-normalization.md
+27 −0 standard/binary.md
+6 −0 standard/dhall.abnf
+12 −0 standard/shift.md
+12 −0 standard/substitution.md
+29 −23 standard/syntax.md
+15 −0 standard/type-inference.md
+3 −19 tests/type-inference/success/preludeB.dhall
14 changes: 13 additions & 1 deletion dhall/src/Dhall/Binary.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -150,10 +150,12 @@ decodeExpressionInternal decodeEmbed = go
| sb == "Natural" -> return Natural
8 | sb == "Optional" -> return Optional
| sb == "TimeZone" -> return TimeZone
9 | sb == "List/fold" -> return ListFold
9 | sb == "Date/show" -> return DateShow
| sb == "List/fold" -> return ListFold
| sb == "List/head" -> return ListHead
| sb == "List/last" -> return ListLast
| sb == "Text/show" -> return TextShow
| sb == "Time/show" -> return TimeShow
10 | sb == "List/build" -> return ListBuild
11 | sb == "Double/show" -> return DoubleShow
| sb == "List/length" -> return ListLength
Expand All @@ -167,6 +169,7 @@ decodeExpressionInternal decodeEmbed = go
| sb == "Text/replace" -> return TextReplace
13 | sb == "Integer/clamp" -> return IntegerClamp
| sb == "Natural/build" -> return NaturalBuild
| sb == "TimeZone/show" -> return TimeZoneShow
14 | sb == "Integer/negate" -> return IntegerNegate
| sb == "Natural/isZero" -> return NaturalIsZero
16 | sb == "Integer/toDouble" -> return IntegerToDouble
Expand Down Expand Up @@ -774,12 +777,21 @@ encodeExpressionInternal encodeEmbed = go
Date ->
Encoding.encodeUtf8ByteArray "Date"

DateShow ->
Encoding.encodeUtf8ByteArray "Date/show"

Time ->
Encoding.encodeUtf8ByteArray "Time"

TimeShow ->
Encoding.encodeUtf8ByteArray "Time/show"

TimeZone ->
Encoding.encodeUtf8ByteArray "TimeZone"

TimeZoneShow ->
Encoding.encodeUtf8ByteArray "TimeZone/show"

List ->
Encoding.encodeUtf8ByteArray "List"

Expand Down
18 changes: 18 additions & 0 deletions dhall/src/Dhall/Diff.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1310,18 +1310,36 @@ diffPrimitiveExpression l r@Date =
mismatch l r
diffPrimitiveExpression l@Date r=
mismatch l r
diffPrimitiveExpression DateShow DateShow =
"…"
diffPrimitiveExpression l r@DateShow =
mismatch l r
diffPrimitiveExpression l@DateShow r=
mismatch l r
diffPrimitiveExpression Time Time =
"…"
diffPrimitiveExpression l r@Time =
mismatch l r
diffPrimitiveExpression l@Time r=
mismatch l r
diffPrimitiveExpression TimeShow TimeShow =
"…"
diffPrimitiveExpression l r@TimeShow =
mismatch l r
diffPrimitiveExpression l@TimeShow r=
mismatch l r
diffPrimitiveExpression TimeZone TimeZone =
"…"
diffPrimitiveExpression l r@TimeZone =
mismatch l r
diffPrimitiveExpression l@TimeZone r=
mismatch l r
diffPrimitiveExpression TimeZoneShow TimeZoneShow =
"…"
diffPrimitiveExpression l r@TimeZoneShow =
mismatch l r
diffPrimitiveExpression l@TimeZoneShow r=
mismatch l r
diffPrimitiveExpression List List =
"…"
diffPrimitiveExpression l@List r =
Expand Down
64 changes: 62 additions & 2 deletions dhall/src/Dhall/Eval.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,9 @@ module Dhall.Eval (
, Val(..)
, (~>)
, textShow
, dateShow
, timeShow
, timezoneShow
) where

import Data.Bifunctor (first)
Expand All @@ -54,6 +57,7 @@ import Data.Foldable (foldr', toList)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Sequence (Seq, ViewL (..), ViewR (..))
import Data.Text (Text)
import Data.Time (Day, TimeOfDay(..), TimeZone)
import Data.Void (Void)
import Dhall.Map (Map)
import Dhall.Set (Set)
Expand Down Expand Up @@ -81,7 +85,7 @@ import qualified Data.Time as Time
import qualified Dhall.Map as Map
import qualified Dhall.Set
import qualified Dhall.Syntax as Syntax
import qualified Text.Printf
import qualified Text.Printf as Printf

data Environment a
= Empty
Expand Down Expand Up @@ -206,10 +210,13 @@ data Val a

| VDate
| VDateLiteral Time.Day
| VDateShow !(Val a)
| VTime
| VTimeLiteral Time.TimeOfDay Word
| VTimeShow !(Val a)
| VTimeZone
| VTimeZoneLiteral Time.TimeZone
| VTimeZoneShow !(Val a)

| VList !(Val a)
| VListLit !(Maybe (Val a)) !(Seq (Val a))
Expand Down Expand Up @@ -667,14 +674,26 @@ eval !env t0 =
VDate
DateLiteral d ->
VDateLiteral d
DateShow ->
VPrim $ \case
VDateLiteral d -> VTextLit (VChunks [] (dateShow d))
t -> VDateShow t
Time ->
VTime
TimeLiteral t p ->
VTimeLiteral t p
TimeShow ->
VPrim $ \case
VTimeLiteral d p -> VTextLit (VChunks [] (timeShow d p))
t -> VTimeShow t
TimeZone ->
VTimeZone
TimeZoneLiteral z ->
VTimeZoneLiteral z
TimeZoneShow ->
VPrim $ \case
VTimeZoneLiteral d -> VTextLit (VChunks [] (timezoneShow d))
t -> VTimeZoneShow t
List ->
VPrim VList
ListLit ma ts ->
Expand Down Expand Up @@ -898,9 +917,32 @@ textShow text = "\"" <> Text.concatMap f text <> "\""
f '\r' = "\\r"
f '\t' = "\\t"
f '\f' = "\\f"
f c | c <= '\x1F' = Text.pack (Text.Printf.printf "\\u%04x" (Data.Char.ord c))
f c | c <= '\x1F' = Text.pack (Printf.printf "\\u%04x" (Data.Char.ord c))
| otherwise = Text.singleton c

-- | Utility that powers the @Date/show@ built-in
dateShow :: Day -> Text
dateShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d"

-- | Utility that powers the @Time/show@ built-in
timeShow :: TimeOfDay -> Word -> Text
timeShow (TimeOfDay hh mm seconds) precision =
Text.pack (Printf.printf "%02d:%02d:%02d" hh mm ss <> suffix)
where
magnitude :: Integer
magnitude = 10 ^ precision

(ss, fraction) =
truncate (seconds * fromInteger magnitude) `divMod` magnitude

suffix
| precision == 0 = ""
| otherwise = Printf.printf ".%0*d" precision fraction

-- | Utility that powers the @TimeZone/show@ built-in
timezoneShow :: TimeZone -> Text
timezoneShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%Ez"

conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv !env t0 t0' =
case (t0, t0') of
Expand Down Expand Up @@ -1008,14 +1050,20 @@ conv !env t0 t0' =
True
(VDateLiteral l, VDateLiteral r) ->
l == r
(VDateShow t, VDateShow t') ->
conv env t t'
(VTime, VTime) ->
True
(VTimeLiteral tl pl, VTimeLiteral tr pr) ->
tl == tr && pl == pr
(VTimeShow t, VTimeShow t') ->
conv env t t'
(VTimeZone, VTimeZone) ->
True
(VTimeZoneLiteral l, VTimeZoneLiteral r) ->
l == r
(VTimeZoneShow t, VTimeZoneShow t') ->
conv env t t'
(VList a, VList a') ->
conv env a a'
(VListLit _ xs, VListLit _ xs') ->
Expand Down Expand Up @@ -1224,14 +1272,20 @@ quote !env !t0 =
Date
VDateLiteral d ->
DateLiteral d
VDateShow t ->
DateShow `qApp` t
VTime ->
Time
VTimeLiteral t p ->
TimeLiteral t p
VTimeShow t ->
TimeShow `qApp` t
VTimeZone ->
TimeZone
VTimeZoneLiteral z ->
TimeZoneLiteral z
VTimeZoneShow t ->
TimeZoneShow `qApp` t
VList t ->
List `qApp` t
VListLit ma ts ->
Expand Down Expand Up @@ -1427,14 +1481,20 @@ alphaNormalize = goEnv EmptyNames
Date
DateLiteral d ->
DateLiteral d
DateShow ->
DateShow
Time ->
Time
TimeLiteral t p ->
TimeLiteral t p
TimeShow ->
TimeShow
TimeZone ->
TimeZone
TimeZoneLiteral z ->
TimeZoneLiteral z
TimeZoneShow ->
TimeZoneShow
List ->
List
ListLit ma ts ->
Expand Down
21 changes: 21 additions & 0 deletions dhall/src/Dhall/Normalize.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -375,6 +375,18 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0)
suffix

loop (TextAppend (TextLit (Chunks [(prefix, replacement)] "")) (App (App (App TextReplace (TextLit (Chunks [] needleText))) replacement) (TextLit (Chunks ((remainder, firstInterpolation) : chunks) lastText))))
App DateShow (DateLiteral date) ->
loop (TextLit (Chunks [] text))
where
text = Eval.dateShow date
App TimeShow (TimeLiteral time precision) ->
loop (TextLit (Chunks [] text))
where
text = Eval.timeShow time precision
App TimeZoneShow (TimeZoneLiteral timezone) ->
loop (TextLit (Chunks [] text))
where
text = Eval.timezoneShow timezone
_ -> do
res2 <- ctx (App f' a')
case res2 of
Expand Down Expand Up @@ -483,10 +495,13 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0)
TextShow -> pure TextShow
Date -> pure Date
DateLiteral d -> pure (DateLiteral d)
DateShow -> pure DateShow
Time -> pure Time
TimeLiteral t p -> pure (TimeLiteral t p)
TimeShow -> pure TimeShow
TimeZone -> pure TimeZone
TimeZoneLiteral z -> pure (TimeZoneLiteral z)
TimeZoneShow -> pure TimeZoneShow
List -> pure List
ListLit t es
| Data.Sequence.null es -> ListLit <$> t' <*> pure Data.Sequence.empty
Expand Down Expand Up @@ -783,6 +798,9 @@ isNormalized e0 = loop (Syntax.denote e0)
App NaturalEven (NaturalLit _) -> False
App NaturalOdd (NaturalLit _) -> False
App NaturalShow (NaturalLit _) -> False
App DateShow (DateLiteral _) -> False
App TimeShow (TimeLiteral _ _) -> False
App TimeZoneShow (TimeZoneLiteral _) -> False
App (App NaturalSubtract (NaturalLit _)) (NaturalLit _) -> False
App (App NaturalSubtract (NaturalLit 0)) _ -> False
App (App NaturalSubtract _) (NaturalLit 0) -> False
Expand Down Expand Up @@ -884,10 +902,13 @@ isNormalized e0 = loop (Syntax.denote e0)
TextShow -> True
Date -> True
DateLiteral _ -> True
DateShow -> True
Time -> True
TimeLiteral _ _ -> True
TimeShow -> True
TimeZone -> True
TimeZoneLiteral _ -> True
TimeZoneShow -> True
List -> True
ListLit t es -> all loop t && all loop es
ListAppend x y -> loop x && loop y && decide x y
Expand Down
5 changes: 4 additions & 1 deletion dhall/src/Dhall/Parser/Expression.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -722,7 +722,8 @@ parsers embedded = Parsers{..}

'D' ->
choice
[ Date <$ _Date
[ DateShow <$ _DateShow
, Date <$ _Date
, DoubleShow <$ _DoubleShow
, Double <$ _Double
]
Expand All @@ -749,7 +750,9 @@ parsers embedded = Parsers{..}
[ TextReplace <$ _TextReplace
, TextShow <$ _TextShow
, Text <$ _Text
, TimeZoneShow <$ _TimeZoneShow
, TimeZone <$ _TimeZone
, TimeShow <$ _TimeShow
, Time <$ _Time
, BoolLit True <$ _True
, Const Type <$ _Type
Expand Down
Loading

0 comments on commit 3aadd57

Please sign in to comment.