Skip to content

Commit 3efdc6d

Browse files
Gabriella439Gabriella439
authored
Add support for Date / Time / TimeZone (#2247)
… as standardized in dhall-lang/dhall-lang#1191
1 parent 056e6b6 commit 3efdc6d

File tree

20 files changed

+760
-18
lines changed

20 files changed

+760
-18
lines changed

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

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,7 @@ import qualified Data.Text
113113
import qualified Data.Text.Encoding
114114
import qualified Dhall.Core
115115
import qualified Dhall.Map
116+
import qualified Dhall.Pretty
116117
import qualified NeatInterpolation
117118
import qualified Text.ShellEscape
118119

@@ -250,6 +251,9 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
250251
return bytes
251252
go (Some b) = go b
252253
go (App None _) = return ("unset " <> var)
254+
go e
255+
| Just text <- Dhall.Pretty.temporalToText e =
256+
go (TextLit (Chunks [] text))
253257
go (RecordLit a) = do
254258
let process (k, v) = do
255259
v' <- dhallToExpression v
@@ -311,6 +315,12 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
311315
go e@(TextAppend {}) = Left (UnsupportedStatement e)
312316
go e@(TextReplace {}) = Left (UnsupportedStatement e)
313317
go e@(TextShow {}) = Left (UnsupportedStatement e)
318+
go e@(Date ) = Left (UnsupportedStatement e)
319+
go e@(DateLiteral {}) = Left (UnsupportedStatement e)
320+
go e@(Time ) = Left (UnsupportedStatement e)
321+
go e@(TimeLiteral {}) = Left (UnsupportedStatement e)
322+
go e@(TimeZone ) = Left (UnsupportedStatement e)
323+
go e@(TimeZoneLiteral {}) = Left (UnsupportedStatement e)
314324
go e@(List ) = Left (UnsupportedStatement e)
315325
go e@(ListAppend {}) = Left (UnsupportedStatement e)
316326
go e@(ListBuild ) = Left (UnsupportedStatement e)
@@ -366,4 +376,7 @@ dhallToExpression expr0 = go (Dhall.Core.normalize expr0)
366376
case Dhall.Map.lookup k m of
367377
Just Nothing -> go (TextLit (Chunks [] k))
368378
_ -> Left (UnsupportedExpression e)
379+
go e
380+
| Just text <- Dhall.Pretty.temporalToText e =
381+
go (TextLit (Chunks [] text))
369382
go e = Left (UnsupportedExpression e)

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

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -430,6 +430,8 @@ dhallToJSON e0 = loop (Core.alphaNormalize (Core.normalize e0))
430430
--
431431
-- See: https://github.com/dhall-lang/dhall-lang/issues/492
432432
Core.None -> Left BareNone
433+
_ | Just text <- Dhall.Pretty.temporalToText e ->
434+
loop (Core.TextLit (Core.Chunks [] text))
433435
Core.RecordLit a ->
434436
case toOrderedList a of
435437
[ ( "contents"
@@ -882,6 +884,24 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
882884
Core.TextShow ->
883885
Core.TextShow
884886

887+
Core.Date ->
888+
Core.Date
889+
890+
Core.DateLiteral d ->
891+
Core.DateLiteral d
892+
893+
Core.Time ->
894+
Core.Time
895+
896+
Core.TimeLiteral t p ->
897+
Core.TimeLiteral t p
898+
899+
Core.TimeZone ->
900+
Core.TimeZone
901+
902+
Core.TimeZoneLiteral z ->
903+
Core.TimeZoneLiteral z
904+
885905
Core.List ->
886906
Core.List
887907

‎dhall-json/tasty/Main.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ testTree =
5757
, testDhallToJSON "./tasty/data/nesting3"
5858
, testDhallToJSON "./tasty/data/nestingLegacy0"
5959
, testDhallToJSON "./tasty/data/nestingLegacy1"
60+
, testDhallToJSON "./tasty/data/time"
6061
]
6162
, Test.Tasty.testGroup "Union keys"
6263
[ testJSONToDhall "./tasty/data/unionKeys"

‎dhall-json/tasty/data/time.dhall‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
{ example0 = 2020-01-01
2+
, example1 = 00:00:00
3+
, example2 = +00:00
4+
, example3 = 2020-01-01T00:00:00
5+
, example4 = 00:00:00+00:00
6+
, example5 = 2020-01-01T00:00:00+00:00
7+
}

‎dhall-json/tasty/data/time.json‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
{
2+
"example0": "2020-01-01",
3+
"example1": "00:00:00",
4+
"example2": "+00:00",
5+
"example3": "2020-01-01T00:00:00",
6+
"example4": "00:00:00+00:00",
7+
"example5": "2020-01-01T00:00:00+00:00"
8+
}

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

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,7 @@ import qualified Data.Text
130130
import qualified Dhall.Core
131131
import qualified Dhall.Map
132132
import qualified Dhall.Optics
133+
import qualified Dhall.Pretty
133134
import qualified NeatInterpolation
134135
import qualified Nix
135136

@@ -482,6 +483,9 @@ dhallToNix e =
482483
let quoted = Nix.mkStr "\"" $+ replaced $+ Nix.mkStr "\""
483484

484485
return ("t" ==> quoted)
486+
loop Date = return untranslatable
487+
loop Time = return untranslatable
488+
loop TimeZone = return untranslatable
485489
loop List = return (Fix (NAbs "t" untranslatable))
486490
loop (ListAppend a b) = do
487491
a' <- loop a
@@ -537,6 +541,14 @@ dhallToNix e =
537541
loop Optional = return (Fix (NAbs "t" untranslatable))
538542
loop (Some a) = loop a
539543
loop None = return (Fix (NConstant NNull))
544+
loop t
545+
| Just text <- Dhall.Pretty.temporalToText t = do
546+
loop (Dhall.Core.TextLit (Dhall.Core.Chunks [] text))
547+
-- The next three cases are not necessary, because they are handled by the
548+
-- previous case
549+
loop DateLiteral{} = undefined
550+
loop TimeLiteral{} = undefined
551+
loop TimeZoneLiteral{} = undefined
540552
loop (Record _) = return untranslatable
541553
loop (RecordLit a) = do
542554
a' <- traverse (loop . Dhall.Core.recordFieldValue) a

‎dhall/dhall-lang‎

Submodule dhall-lang updated 573 files

‎dhall/dhall.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -514,6 +514,7 @@ Library
514514
text >= 0.11.1.0 && < 1.3 ,
515515
text-manipulate >= 0.2.0.1 && < 0.4 ,
516516
th-lift-instances >= 0.1.13 && < 0.2 ,
517+
time >= 1.1.4 && < 1.13,
517518
transformers >= 0.5.2.0 && < 0.6 ,
518519
unordered-containers >= 0.1.3.0 && < 0.3 ,
519520
uri-encode < 1.6 ,
@@ -689,6 +690,7 @@ Test-Suite tasty
689690
template-haskell ,
690691
temporary >= 1.2.1 && < 1.4 ,
691692
text >= 0.11.1.0 && < 1.3 ,
693+
time ,
692694
transformers ,
693695
turtle < 1.6 ,
694696
unordered-containers ,

‎dhall/src/Dhall/Binary.hs‎

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,9 +50,11 @@ import Dhall.Syntax
5050
)
5151

5252
import Data.Foldable (toList)
53+
import Data.Ratio ((%))
5354
import Data.Void (Void, absurd)
5455
import GHC.Float (double2Float, float2Double)
5556
import Numeric.Half (fromHalf, toHalf)
57+
import Prelude hiding (exponent)
5658

5759
import qualified Codec.CBOR.ByteArray
5860
import qualified Codec.CBOR.Decoding as Decoding
@@ -66,6 +68,7 @@ import qualified Data.ByteString.Short
6668
import qualified Data.Foldable as Foldable
6769
import qualified Data.List.NonEmpty as NonEmpty
6870
import qualified Data.Sequence
71+
import qualified Data.Time as Time
6972
import qualified Dhall.Crypto
7073
import qualified Dhall.Map
7174
import qualified Dhall.Syntax as Syntax
@@ -133,16 +136,19 @@ decodeExpressionInternal decodeEmbed = go
133136

134137
case Data.ByteString.Short.length sb of
135138
4 | sb == "Bool" -> return Bool
139+
| sb == "Date" -> return Date
136140
| sb == "List" -> return List
137141
| sb == "None" -> return None
138142
| sb == "Text" -> return Text
143+
| sb == "Time" -> return Time
139144
| sb == "Type" -> return (Const Type)
140145
| sb == "Kind" -> return (Const Kind)
141146
| sb == "Sort" -> return (Const Sort)
142147
6 | sb == "Double" -> return Double
143148
7 | sb == "Integer" -> return Integer
144149
| sb == "Natural" -> return Natural
145150
8 | sb == "Optional" -> return Optional
151+
| sb == "TimeZone" -> return TimeZone
146152
9 | sb == "List/fold" -> return ListFold
147153
| sb == "List/head" -> return ListHead
148154
| sb == "List/last" -> return ListLast
@@ -566,6 +572,73 @@ decodeExpressionInternal decodeEmbed = go
566572

567573
return (With l ks₁ r)
568574

575+
30 -> do
576+
_YYYY <- Decoding.decodeInt
577+
_MM <- Decoding.decodeInt
578+
_HH <- Decoding.decodeInt
579+
580+
case Time.fromGregorianValid (fromIntegral _YYYY) _MM _HH of
581+
Nothing ->
582+
die "Invalid date"
583+
Just day ->
584+
return (DateLiteral day)
585+
31 -> do
586+
hh <- Decoding.decodeInt
587+
mm <- Decoding.decodeInt
588+
tag₂ <- Decoding.decodeTag
589+
590+
case tag₂ of
591+
4 -> do
592+
return ()
593+
_ -> do
594+
die ("Unexpected tag for decimal fraction: " <> show tag)
595+
n <- Decoding.decodeListLen
596+
597+
case n of
598+
2 -> do
599+
return ()
600+
_ -> do
601+
die ("Invalid list length for decimal fraction: " <> show n)
602+
603+
exponent <- Decoding.decodeInt
604+
605+
tokenType₂ <- Decoding.peekTokenType
606+
607+
mantissa <- case tokenType₂ of
608+
TypeUInt -> do
609+
fromIntegral <$> Decoding.decodeWord
610+
611+
TypeUInt64 -> do
612+
fromIntegral <$> Decoding.decodeWord64
613+
614+
TypeNInt -> do
615+
!i <- fromIntegral <$> Decoding.decodeNegWord
616+
617+
return (-1 - i)
618+
619+
TypeNInt64 -> do
620+
!i <- fromIntegral <$> Decoding.decodeNegWord64
621+
622+
return (-1 - i)
623+
TypeInteger -> do
624+
Decoding.decodeInteger
625+
_ ->
626+
die ("Unexpected token type for mantissa: " <> show tokenType₂)
627+
let precision = fromIntegral (negate exponent)
628+
629+
let ss = fromRational (mantissa % (10 ^ precision))
630+
631+
return (TimeLiteral (Time.TimeOfDay hh mm ss) precision)
632+
32 -> do
633+
b <- Decoding.decodeBool
634+
_HH <- Decoding.decodeInt
635+
_MM <- Decoding.decodeInt
636+
637+
let sign = if b then id else negate
638+
639+
let minutes = sign (_HH * 60 + _MM)
640+
641+
return (TimeZoneLiteral (Time.TimeZone minutes False ""))
569642
_ ->
570643
die ("Unexpected tag: " <> show tag)
571644

@@ -674,6 +747,15 @@ encodeExpressionInternal encodeEmbed = go
674747
TextShow ->
675748
Encoding.encodeUtf8ByteArray "Text/show"
676749

750+
Date ->
751+
Encoding.encodeUtf8ByteArray "Date"
752+
753+
Time ->
754+
Encoding.encodeUtf8ByteArray "Time"
755+
756+
TimeZone ->
757+
Encoding.encodeUtf8ByteArray "TimeZone"
758+
677759
List ->
678760
Encoding.encodeUtf8ByteArray "List"
679761

@@ -936,6 +1018,49 @@ encodeExpressionInternal encodeEmbed = go
9361018
(encodeList (fmap Encoding.encodeString ks))
9371019
(go r)
9381020

1021+
DateLiteral day ->
1022+
encodeList4
1023+
(Encoding.encodeInt 30)
1024+
(Encoding.encodeInt (fromInteger _YYYY))
1025+
(Encoding.encodeInt _MM)
1026+
(Encoding.encodeInt _DD)
1027+
where
1028+
(_YYYY, _MM, _DD) = Time.toGregorian day
1029+
1030+
TimeLiteral (Time.TimeOfDay hh mm ss) precision ->
1031+
encodeList4
1032+
(Encoding.encodeInt 31)
1033+
(Encoding.encodeInt hh)
1034+
(Encoding.encodeInt mm)
1035+
( Encoding.encodeTag 4
1036+
<> encodeList2
1037+
(Encoding.encodeInt exponent)
1038+
encodedMantissa
1039+
)
1040+
where
1041+
exponent = negate (fromIntegral precision)
1042+
1043+
mantissa :: Integer
1044+
mantissa = truncate (ss * 10 ^ precision)
1045+
1046+
encodedMantissa
1047+
| fromIntegral (minBound :: Int) <= mantissa
1048+
&& mantissa <= fromIntegral (maxBound :: Int) =
1049+
Encoding.encodeInt (fromInteger mantissa)
1050+
| otherwise =
1051+
Encoding.encodeInteger mantissa
1052+
1053+
TimeZoneLiteral (Time.TimeZone minutes _ _) ->
1054+
encodeList4
1055+
(Encoding.encodeInt 32)
1056+
(Encoding.encodeBool sign)
1057+
(Encoding.encodeInt _HH)
1058+
(Encoding.encodeInt _MM)
1059+
where
1060+
sign = 0 <= minutes
1061+
1062+
(_HH, _MM) = abs minutes `divMod` 60
1063+
9391064
Note _ b ->
9401065
go b
9411066

0 commit comments

Comments
 (0)