Skip to content

Commit 3aadd57

Browse files
Gabriella439Gabriella439
authored
Add support for {Date,Time,TimeZone}/show (#2493)
… as standardized in dhall-lang/dhall-lang#1328
1 parent 90a674f commit 3aadd57

File tree

15 files changed

+193
-5
lines changed

15 files changed

+193
-5
lines changed

‎dhall-bash/src/Dhall/Bash.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -319,10 +319,13 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
319319
go e@(TextShow {}) = Left (UnsupportedStatement e)
320320
go e@(Date ) = Left (UnsupportedStatement e)
321321
go e@(DateLiteral {}) = Left (UnsupportedStatement e)
322+
go e@(DateShow ) = Left (UnsupportedStatement e)
322323
go e@(Time ) = Left (UnsupportedStatement e)
323324
go e@(TimeLiteral {}) = Left (UnsupportedStatement e)
325+
go e@(TimeShow ) = Left (UnsupportedStatement e)
324326
go e@(TimeZone ) = Left (UnsupportedStatement e)
325327
go e@(TimeZoneLiteral {}) = Left (UnsupportedStatement e)
328+
go e@(TimeZoneShow ) = Left (UnsupportedStatement e)
326329
go e@(List ) = Left (UnsupportedStatement e)
327330
go e@(ListAppend {}) = Left (UnsupportedStatement e)
328331
go e@(ListBuild ) = Left (UnsupportedStatement e)

‎dhall-json/src/Dhall/JSON.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -898,18 +898,27 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
898898
Core.DateLiteral d ->
899899
Core.DateLiteral d
900900

901+
Core.DateShow ->
902+
Core.DateShow
903+
901904
Core.Time ->
902905
Core.Time
903906

904907
Core.TimeLiteral t p ->
905908
Core.TimeLiteral t p
906909

910+
Core.TimeShow ->
911+
Core.TimeShow
912+
907913
Core.TimeZone ->
908914
Core.TimeZone
909915

910916
Core.TimeZoneLiteral z ->
911917
Core.TimeZoneLiteral z
912918

919+
Core.TimeZoneShow ->
920+
Core.TimeZoneShow
921+
913922
Core.List ->
914923
Core.List
915924

‎dhall-nix/src/Dhall/Nix.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -609,6 +609,14 @@ dhallToNix e =
609609
loop DateLiteral{} = undefined
610610
loop TimeLiteral{} = undefined
611611
loop TimeZoneLiteral{} = undefined
612+
-- We currently model `Date`/`Time`/`TimeZone` literals as strings in Nix,
613+
-- so the corresponding show functions are the identity function
614+
loop DateShow =
615+
return ("date" ==> "date")
616+
loop TimeShow =
617+
return ("time" ==> "time")
618+
loop TimeZoneShow =
619+
return ("timeZone" ==> "timeZone")
612620
loop (Record _) = return untranslatable
613621
loop (RecordLit a) = do
614622
a' <- traverse (loop . Dhall.Core.recordFieldValue) a

‎dhall/dhall-lang

‎dhall/src/Dhall/Binary.hs

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -150,10 +150,12 @@ decodeExpressionInternal decodeEmbed = go
150150
| sb == "Natural" -> return Natural
151151
8 | sb == "Optional" -> return Optional
152152
| sb == "TimeZone" -> return TimeZone
153-
9 | sb == "List/fold" -> return ListFold
153+
9 | sb == "Date/show" -> return DateShow
154+
| sb == "List/fold" -> return ListFold
154155
| sb == "List/head" -> return ListHead
155156
| sb == "List/last" -> return ListLast
156157
| sb == "Text/show" -> return TextShow
158+
| sb == "Time/show" -> return TimeShow
157159
10 | sb == "List/build" -> return ListBuild
158160
11 | sb == "Double/show" -> return DoubleShow
159161
| sb == "List/length" -> return ListLength
@@ -167,6 +169,7 @@ decodeExpressionInternal decodeEmbed = go
167169
| sb == "Text/replace" -> return TextReplace
168170
13 | sb == "Integer/clamp" -> return IntegerClamp
169171
| sb == "Natural/build" -> return NaturalBuild
172+
| sb == "TimeZone/show" -> return TimeZoneShow
170173
14 | sb == "Integer/negate" -> return IntegerNegate
171174
| sb == "Natural/isZero" -> return NaturalIsZero
172175
16 | sb == "Integer/toDouble" -> return IntegerToDouble
@@ -774,12 +777,21 @@ encodeExpressionInternal encodeEmbed = go
774777
Date ->
775778
Encoding.encodeUtf8ByteArray "Date"
776779

780+
DateShow ->
781+
Encoding.encodeUtf8ByteArray "Date/show"
782+
777783
Time ->
778784
Encoding.encodeUtf8ByteArray "Time"
779785

786+
TimeShow ->
787+
Encoding.encodeUtf8ByteArray "Time/show"
788+
780789
TimeZone ->
781790
Encoding.encodeUtf8ByteArray "TimeZone"
782791

792+
TimeZoneShow ->
793+
Encoding.encodeUtf8ByteArray "TimeZone/show"
794+
783795
List ->
784796
Encoding.encodeUtf8ByteArray "List"
785797

‎dhall/src/Dhall/Diff.hs

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1310,18 +1310,36 @@ diffPrimitiveExpression l r@Date =
13101310
mismatch l r
13111311
diffPrimitiveExpression l@Date r=
13121312
mismatch l r
1313+
diffPrimitiveExpression DateShow DateShow =
1314+
"…"
1315+
diffPrimitiveExpression l r@DateShow =
1316+
mismatch l r
1317+
diffPrimitiveExpression l@DateShow r=
1318+
mismatch l r
13131319
diffPrimitiveExpression Time Time =
13141320
"…"
13151321
diffPrimitiveExpression l r@Time =
13161322
mismatch l r
13171323
diffPrimitiveExpression l@Time r=
13181324
mismatch l r
1325+
diffPrimitiveExpression TimeShow TimeShow =
1326+
"…"
1327+
diffPrimitiveExpression l r@TimeShow =
1328+
mismatch l r
1329+
diffPrimitiveExpression l@TimeShow r=
1330+
mismatch l r
13191331
diffPrimitiveExpression TimeZone TimeZone =
13201332
"…"
13211333
diffPrimitiveExpression l r@TimeZone =
13221334
mismatch l r
13231335
diffPrimitiveExpression l@TimeZone r=
13241336
mismatch l r
1337+
diffPrimitiveExpression TimeZoneShow TimeZoneShow =
1338+
"…"
1339+
diffPrimitiveExpression l r@TimeZoneShow =
1340+
mismatch l r
1341+
diffPrimitiveExpression l@TimeZoneShow r=
1342+
mismatch l r
13251343
diffPrimitiveExpression List List =
13261344
"…"
13271345
diffPrimitiveExpression l@List r =

‎dhall/src/Dhall/Eval.hs

Lines changed: 62 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,9 @@ module Dhall.Eval (
4646
, Val(..)
4747
, (~>)
4848
, textShow
49+
, dateShow
50+
, timeShow
51+
, timezoneShow
4952
) where
5053

5154
import Data.Bifunctor (first)
@@ -54,6 +57,7 @@ import Data.Foldable (foldr', toList)
5457
import Data.List.NonEmpty (NonEmpty (..))
5558
import Data.Sequence (Seq, ViewL (..), ViewR (..))
5659
import Data.Text (Text)
60+
import Data.Time (Day, TimeOfDay(..), TimeZone)
5761
import Data.Void (Void)
5862
import Dhall.Map (Map)
5963
import Dhall.Set (Set)
@@ -81,7 +85,7 @@ import qualified Data.Time as Time
8185
import qualified Dhall.Map as Map
8286
import qualified Dhall.Set
8387
import qualified Dhall.Syntax as Syntax
84-
import qualified Text.Printf
88+
import qualified Text.Printf as Printf
8589

8690
data Environment a
8791
= Empty
@@ -206,10 +210,13 @@ data Val a
206210

207211
| VDate
208212
| VDateLiteral Time.Day
213+
| VDateShow !(Val a)
209214
| VTime
210215
| VTimeLiteral Time.TimeOfDay Word
216+
| VTimeShow !(Val a)
211217
| VTimeZone
212218
| VTimeZoneLiteral Time.TimeZone
219+
| VTimeZoneShow !(Val a)
213220

214221
| VList !(Val a)
215222
| VListLit !(Maybe (Val a)) !(Seq (Val a))
@@ -667,14 +674,26 @@ eval !env t0 =
667674
VDate
668675
DateLiteral d ->
669676
VDateLiteral d
677+
DateShow ->
678+
VPrim $ \case
679+
VDateLiteral d -> VTextLit (VChunks [] (dateShow d))
680+
t -> VDateShow t
670681
Time ->
671682
VTime
672683
TimeLiteral t p ->
673684
VTimeLiteral t p
685+
TimeShow ->
686+
VPrim $ \case
687+
VTimeLiteral d p -> VTextLit (VChunks [] (timeShow d p))
688+
t -> VTimeShow t
674689
TimeZone ->
675690
VTimeZone
676691
TimeZoneLiteral z ->
677692
VTimeZoneLiteral z
693+
TimeZoneShow ->
694+
VPrim $ \case
695+
VTimeZoneLiteral d -> VTextLit (VChunks [] (timezoneShow d))
696+
t -> VTimeZoneShow t
678697
List ->
679698
VPrim VList
680699
ListLit ma ts ->
@@ -898,9 +917,32 @@ textShow text = "\"" <> Text.concatMap f text <> "\""
898917
f '\r' = "\\r"
899918
f '\t' = "\\t"
900919
f '\f' = "\\f"
901-
f c | c <= '\x1F' = Text.pack (Text.Printf.printf "\\u%04x" (Data.Char.ord c))
920+
f c | c <= '\x1F' = Text.pack (Printf.printf "\\u%04x" (Data.Char.ord c))
902921
| otherwise = Text.singleton c
903922

923+
-- | Utility that powers the @Date/show@ built-in
924+
dateShow :: Day -> Text
925+
dateShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%0Y-%m-%d"
926+
927+
-- | Utility that powers the @Time/show@ built-in
928+
timeShow :: TimeOfDay -> Word -> Text
929+
timeShow (TimeOfDay hh mm seconds) precision =
930+
Text.pack (Printf.printf "%02d:%02d:%02d" hh mm ss <> suffix)
931+
where
932+
magnitude :: Integer
933+
magnitude = 10 ^ precision
934+
935+
(ss, fraction) =
936+
truncate (seconds * fromInteger magnitude) `divMod` magnitude
937+
938+
suffix
939+
| precision == 0 = ""
940+
| otherwise = Printf.printf ".%0*d" precision fraction
941+
942+
-- | Utility that powers the @TimeZone/show@ built-in
943+
timezoneShow :: TimeZone -> Text
944+
timezoneShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%Ez"
945+
904946
conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool
905947
conv !env t0 t0' =
906948
case (t0, t0') of
@@ -1008,14 +1050,20 @@ conv !env t0 t0' =
10081050
True
10091051
(VDateLiteral l, VDateLiteral r) ->
10101052
l == r
1053+
(VDateShow t, VDateShow t') ->
1054+
conv env t t'
10111055
(VTime, VTime) ->
10121056
True
10131057
(VTimeLiteral tl pl, VTimeLiteral tr pr) ->
10141058
tl == tr && pl == pr
1059+
(VTimeShow t, VTimeShow t') ->
1060+
conv env t t'
10151061
(VTimeZone, VTimeZone) ->
10161062
True
10171063
(VTimeZoneLiteral l, VTimeZoneLiteral r) ->
10181064
l == r
1065+
(VTimeZoneShow t, VTimeZoneShow t') ->
1066+
conv env t t'
10191067
(VList a, VList a') ->
10201068
conv env a a'
10211069
(VListLit _ xs, VListLit _ xs') ->
@@ -1224,14 +1272,20 @@ quote !env !t0 =
12241272
Date
12251273
VDateLiteral d ->
12261274
DateLiteral d
1275+
VDateShow t ->
1276+
DateShow `qApp` t
12271277
VTime ->
12281278
Time
12291279
VTimeLiteral t p ->
12301280
TimeLiteral t p
1281+
VTimeShow t ->
1282+
TimeShow `qApp` t
12311283
VTimeZone ->
12321284
TimeZone
12331285
VTimeZoneLiteral z ->
12341286
TimeZoneLiteral z
1287+
VTimeZoneShow t ->
1288+
TimeZoneShow `qApp` t
12351289
VList t ->
12361290
List `qApp` t
12371291
VListLit ma ts ->
@@ -1427,14 +1481,20 @@ alphaNormalize = goEnv EmptyNames
14271481
Date
14281482
DateLiteral d ->
14291483
DateLiteral d
1484+
DateShow ->
1485+
DateShow
14301486
Time ->
14311487
Time
14321488
TimeLiteral t p ->
14331489
TimeLiteral t p
1490+
TimeShow ->
1491+
TimeShow
14341492
TimeZone ->
14351493
TimeZone
14361494
TimeZoneLiteral z ->
14371495
TimeZoneLiteral z
1496+
TimeZoneShow ->
1497+
TimeZoneShow
14381498
List ->
14391499
List
14401500
ListLit ma ts ->

‎dhall/src/Dhall/Normalize.hs

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -375,6 +375,18 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0)
375375
suffix
376376

377377
loop (TextAppend (TextLit (Chunks [(prefix, replacement)] "")) (App (App (App TextReplace (TextLit (Chunks [] needleText))) replacement) (TextLit (Chunks ((remainder, firstInterpolation) : chunks) lastText))))
378+
App DateShow (DateLiteral date) ->
379+
loop (TextLit (Chunks [] text))
380+
where
381+
text = Eval.dateShow date
382+
App TimeShow (TimeLiteral time precision) ->
383+
loop (TextLit (Chunks [] text))
384+
where
385+
text = Eval.timeShow time precision
386+
App TimeZoneShow (TimeZoneLiteral timezone) ->
387+
loop (TextLit (Chunks [] text))
388+
where
389+
text = Eval.timezoneShow timezone
378390
_ -> do
379391
res2 <- ctx (App f' a')
380392
case res2 of
@@ -483,10 +495,13 @@ normalizeWithM ctx e0 = loop (Syntax.denote e0)
483495
TextShow -> pure TextShow
484496
Date -> pure Date
485497
DateLiteral d -> pure (DateLiteral d)
498+
DateShow -> pure DateShow
486499
Time -> pure Time
487500
TimeLiteral t p -> pure (TimeLiteral t p)
501+
TimeShow -> pure TimeShow
488502
TimeZone -> pure TimeZone
489503
TimeZoneLiteral z -> pure (TimeZoneLiteral z)
504+
TimeZoneShow -> pure TimeZoneShow
490505
List -> pure List
491506
ListLit t es
492507
| Data.Sequence.null es -> ListLit <$> t' <*> pure Data.Sequence.empty
@@ -783,6 +798,9 @@ isNormalized e0 = loop (Syntax.denote e0)
783798
App NaturalEven (NaturalLit _) -> False
784799
App NaturalOdd (NaturalLit _) -> False
785800
App NaturalShow (NaturalLit _) -> False
801+
App DateShow (DateLiteral _) -> False
802+
App TimeShow (TimeLiteral _ _) -> False
803+
App TimeZoneShow (TimeZoneLiteral _) -> False
786804
App (App NaturalSubtract (NaturalLit _)) (NaturalLit _) -> False
787805
App (App NaturalSubtract (NaturalLit 0)) _ -> False
788806
App (App NaturalSubtract _) (NaturalLit 0) -> False
@@ -884,10 +902,13 @@ isNormalized e0 = loop (Syntax.denote e0)
884902
TextShow -> True
885903
Date -> True
886904
DateLiteral _ -> True
905+
DateShow -> True
887906
Time -> True
888907
TimeLiteral _ _ -> True
908+
TimeShow -> True
889909
TimeZone -> True
890910
TimeZoneLiteral _ -> True
911+
TimeZoneShow -> True
891912
List -> True
892913
ListLit t es -> all loop t && all loop es
893914
ListAppend x y -> loop x && loop y && decide x y

‎dhall/src/Dhall/Parser/Expression.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -722,7 +722,8 @@ parsers embedded = Parsers{..}
722722

723723
'D' ->
724724
choice
725-
[ Date <$ _Date
725+
[ DateShow <$ _DateShow
726+
, Date <$ _Date
726727
, DoubleShow <$ _DoubleShow
727728
, Double <$ _Double
728729
]
@@ -749,7 +750,9 @@ parsers embedded = Parsers{..}
749750
[ TextReplace <$ _TextReplace
750751
, TextShow <$ _TextShow
751752
, Text <$ _Text
753+
, TimeZoneShow <$ _TimeZoneShow
752754
, TimeZone <$ _TimeZone
755+
, TimeShow <$ _TimeShow
753756
, Time <$ _Time
754757
, BoolLit True <$ _True
755758
, Const Type <$ _Type

0 commit comments

Comments
 (0)