Add support for Date / Time / TimeZone

dhall-bash/src/Dhall/Bash.hs

@@ -113,6 +113,7 @@ import qualified Data.Text
 import qualified Data.Text.Encoding
 import qualified Dhall.Core
 import qualified Dhall.Map
+import qualified Dhall.Pretty
 import qualified NeatInterpolation
 import qualified Text.ShellEscape
 
@@ -250,6 +251,9 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
         return bytes
     go (Some b) = go b
     go (App None _) = return ("unset " <> var)
+    go e
+        | Just text <- Dhall.Pretty.temporalToText e =
+            go (TextLit (Chunks [] text))
     go (RecordLit a) = do
         let process (k, v) = do
                 v' <- dhallToExpression v
@@ -311,6 +315,12 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
     go e@(TextAppend       {}) = Left (UnsupportedStatement e)
     go e@(TextReplace      {}) = Left (UnsupportedStatement e)
     go e@(TextShow         {}) = Left (UnsupportedStatement e)
+    go e@(Date               ) = Left (UnsupportedStatement e)
+    go e@(DateLiteral      {}) = Left (UnsupportedStatement e)
+    go e@(Time               ) = Left (UnsupportedStatement e)
+    go e@(TimeLiteral      {}) = Left (UnsupportedStatement e)
+    go e@(TimeZone           ) = Left (UnsupportedStatement e)
+    go e@(TimeZoneLiteral  {}) = Left (UnsupportedStatement e)
     go e@(List               ) = Left (UnsupportedStatement e)
     go e@(ListAppend       {}) = Left (UnsupportedStatement e)
     go e@(ListBuild          ) = Left (UnsupportedStatement e)
@@ -366,4 +376,7 @@ dhallToExpression expr0 = go (Dhall.Core.normalize expr0)
         case Dhall.Map.lookup k m of
             Just Nothing -> go (TextLit (Chunks [] k))
             _            -> Left (UnsupportedExpression e)
+    go e
+        | Just text <- Dhall.Pretty.temporalToText e =
+            go (TextLit (Chunks [] text))
     go e = Left (UnsupportedExpression e)

dhall-json/src/Dhall/JSON.hs

@@ -430,6 +430,8 @@ dhallToJSON e0 = loop (Core.alphaNormalize (Core.normalize e0))
         --
         -- See: https://github.com/dhall-lang/dhall-lang/issues/492
         Core.None -> Left BareNone
+        _ | Just text <- Dhall.Pretty.temporalToText e ->
+            loop (Core.TextLit (Core.Chunks [] text))
         Core.RecordLit a ->
             case toOrderedList a of
                 [   (   "contents"
@@ -882,6 +884,24 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
         Core.TextShow ->
             Core.TextShow
 
+        Core.Date ->
+            Core.Date
+
+        Core.DateLiteral d ->
+            Core.DateLiteral d
+
+        Core.Time ->
+            Core.Time
+
+        Core.TimeLiteral t p ->
+            Core.TimeLiteral t p
+
+        Core.TimeZone ->
+            Core.TimeZone
+
+        Core.TimeZoneLiteral z ->
+            Core.TimeZoneLiteral z
+
         Core.List ->
             Core.List
 

dhall-json/tasty/Main.hs

@@ -57,6 +57,7 @@ testTree =
             , testDhallToJSON "./tasty/data/nesting3"
             , testDhallToJSON "./tasty/data/nestingLegacy0"
             , testDhallToJSON "./tasty/data/nestingLegacy1"
+            , testDhallToJSON "./tasty/data/time"
             ]
         , Test.Tasty.testGroup "Union keys"
             [ testJSONToDhall "./tasty/data/unionKeys"

dhall-json/tasty/data/time.dhall

@@ -0,0 +1,7 @@
+{ example0 = 2020-01-01
+, example1 = 00:00:00
+, example2 = +00:00
+, example3 = 2020-01-01T00:00:00
+, example4 = 00:00:00+00:00
+, example5 = 2020-01-01T00:00:00+00:00
+}

dhall-json/tasty/data/time.json

@@ -0,0 +1,8 @@
+{
+  "example0": "2020-01-01",
+  "example1": "00:00:00",
+  "example2": "+00:00",
+  "example3": "2020-01-01T00:00:00",
+  "example4": "00:00:00+00:00",
+  "example5": "2020-01-01T00:00:00+00:00"
+}

dhall-nix/src/Dhall/Nix.hs

@@ -130,6 +130,7 @@ import qualified Data.Text
 import qualified Dhall.Core
 import qualified Dhall.Map
 import qualified Dhall.Optics
+import qualified Dhall.Pretty
 import qualified NeatInterpolation
 import qualified Nix
 
@@ -482,6 +483,9 @@ dhallToNix e =
         let quoted = Nix.mkStr "\"" $+ replaced $+ Nix.mkStr "\""
 
         return ("t" ==> quoted)
+    loop Date = return untranslatable
+    loop Time = return untranslatable
+    loop TimeZone = return untranslatable
     loop List = return (Fix (NAbs "t" untranslatable))
     loop (ListAppend a b) = do
         a' <- loop a
@@ -537,6 +541,14 @@ dhallToNix e =
     loop Optional = return (Fix (NAbs "t" untranslatable))
     loop (Some a) = loop a
     loop None = return (Fix (NConstant NNull))
+    loop t
+        | Just text <- Dhall.Pretty.temporalToText t = do
+            loop (Dhall.Core.TextLit (Dhall.Core.Chunks [] text))
+    -- The next three cases are not necessary, because they are handled by the
+    -- previous case
+    loop DateLiteral{} = undefined
+    loop TimeLiteral{} = undefined
+    loop TimeZoneLiteral{} = undefined
     loop (Record _) = return untranslatable
     loop (RecordLit a) = do
         a' <- traverse (loop . Dhall.Core.recordFieldValue) a

dhall/dhall.cabal

@@ -514,6 +514,7 @@ Library
         text                        >= 0.11.1.0 && < 1.3 ,
         text-manipulate             >= 0.2.0.1  && < 0.4 ,
         th-lift-instances           >= 0.1.13   && < 0.2 ,
+        time                        >= 1.1.4    && < 1.13,
         transformers                >= 0.5.2.0  && < 0.6 ,
         unordered-containers        >= 0.1.3.0  && < 0.3 ,
         uri-encode                                 < 1.6 ,
@@ -689,6 +690,7 @@ Test-Suite tasty
         template-haskell                               ,
         temporary                 >= 1.2.1    && < 1.4 ,
         text                      >= 0.11.1.0 && < 1.3 ,
+        time                                           ,
         transformers                                   ,
         turtle                                   < 1.6 ,
         unordered-containers                           ,

dhall/src/Dhall/Binary.hs

@@ -50,9 +50,11 @@ import Dhall.Syntax
     )
 
 import Data.Foldable (toList)
+import Data.Ratio    ((%))
 import Data.Void     (Void, absurd)
 import GHC.Float     (double2Float, float2Double)
 import Numeric.Half  (fromHalf, toHalf)
+import Prelude hiding (exponent)
 
 import qualified Codec.CBOR.ByteArray
 import qualified Codec.CBOR.Decoding   as Decoding
@@ -66,6 +68,7 @@ import qualified Data.ByteString.Short
 import qualified Data.Foldable         as Foldable
 import qualified Data.List.NonEmpty    as NonEmpty
 import qualified Data.Sequence
+import qualified Data.Time             as Time
 import qualified Dhall.Crypto
 import qualified Dhall.Map
 import qualified Dhall.Syntax          as Syntax
@@ -133,16 +136,19 @@ decodeExpressionInternal decodeEmbed = go
 
                 case Data.ByteString.Short.length sb of
                     4  | sb == "Bool"              -> return Bool
+                       | sb == "Date"              -> return Date
                        | sb == "List"              -> return List
                        | sb == "None"              -> return None
                        | sb == "Text"              -> return Text
+                       | sb == "Time"              -> return Time
                        | sb == "Type"              -> return (Const Type)
                        | sb == "Kind"              -> return (Const Kind)
                        | sb == "Sort"              -> return (Const Sort)
                     6  | sb == "Double"            -> return Double
                     7  | sb == "Integer"           -> return Integer
                        | sb == "Natural"           -> return Natural
                     8  | sb == "Optional"          -> return Optional
+                       | sb == "TimeZone"          -> return TimeZone
                     9  | sb == "List/fold"         -> return ListFold
                        | sb == "List/head"         -> return ListHead
                        | sb == "List/last"         -> return ListLast
@@ -566,6 +572,73 @@ decodeExpressionInternal decodeEmbed = go
 
                                 return (With l ks₁ r)
 
+                            30 -> do
+                                _YYYY <- Decoding.decodeInt
+                                _MM   <- Decoding.decodeInt
+                                _HH   <- Decoding.decodeInt
+
+                                case Time.fromGregorianValid (fromIntegral _YYYY) _MM _HH of
+                                    Nothing ->
+                                        die "Invalid date"
+                                    Just day ->
+                                        return (DateLiteral day)
+                            31 -> do
+                                hh <- Decoding.decodeInt
+                                mm <- Decoding.decodeInt
+                                tag₂ <- Decoding.decodeTag
+
+                                case tag₂ of
+                                    4 -> do
+                                        return ()
+                                    _ -> do
+                                        die ("Unexpected tag for decimal fraction: " <> show tag)
+                                n <- Decoding.decodeListLen
+
+                                case n of
+                                    2 -> do
+                                        return ()
+                                    _ -> do
+                                        die ("Invalid list length for decimal fraction: " <> show n)
+
+                                exponent <- Decoding.decodeInt
+
+                                tokenType₂ <- Decoding.peekTokenType
+
+                                mantissa <- case tokenType₂ of
+                                    TypeUInt -> do
+                                        fromIntegral <$> Decoding.decodeWord
+
+                                    TypeUInt64 -> do
+                                        fromIntegral <$> Decoding.decodeWord64
+
+                                    TypeNInt -> do
+                                        !i <- fromIntegral <$> Decoding.decodeNegWord
+
+                                        return (-1 - i)
+
+                                    TypeNInt64 -> do
+                                        !i <- fromIntegral <$> Decoding.decodeNegWord64
+
+                                        return (-1 - i)
+                                    TypeInteger -> do
+                                        Decoding.decodeInteger
+                                    _ ->
+                                        die ("Unexpected token type for mantissa: " <> show tokenType₂)
+                                let precision = fromIntegral (negate exponent)
+
+                                let ss = fromRational (mantissa % (10 ^ precision))
+
+                                return (TimeLiteral (Time.TimeOfDay hh mm ss) precision)
+                            32 -> do
+                                b   <- Decoding.decodeBool
+                                _HH <- Decoding.decodeInt
+                                _MM <- Decoding.decodeInt
+
+                                let sign = if b then id else negate
+
+                                let minutes = sign (_HH * 60 + _MM)
+
+                                return (TimeZoneLiteral (Time.TimeZone minutes False ""))
                             _ ->
                                 die ("Unexpected tag: " <> show tag)
 
@@ -674,6 +747,15 @@ encodeExpressionInternal encodeEmbed = go
         TextShow ->
             Encoding.encodeUtf8ByteArray "Text/show"
 
+        Date ->
+            Encoding.encodeUtf8ByteArray "Date"
+
+        Time ->
+            Encoding.encodeUtf8ByteArray "Time"
+
+        TimeZone ->
+            Encoding.encodeUtf8ByteArray "TimeZone"
+
         List ->
             Encoding.encodeUtf8ByteArray "List"
 
@@ -936,6 +1018,49 @@ encodeExpressionInternal encodeEmbed = go
                 (encodeList (fmap Encoding.encodeString ks))
                 (go r)
 
+        DateLiteral day ->
+            encodeList4
+                (Encoding.encodeInt 30)
+                (Encoding.encodeInt (fromInteger _YYYY))
+                (Encoding.encodeInt _MM)
+                (Encoding.encodeInt _DD)
+          where
+            (_YYYY, _MM, _DD) = Time.toGregorian day
+
+        TimeLiteral (Time.TimeOfDay hh mm ss) precision ->
+            encodeList4
+                (Encoding.encodeInt 31)
+                (Encoding.encodeInt hh)
+                (Encoding.encodeInt mm)
+                (   Encoding.encodeTag 4
+                <>  encodeList2
+                        (Encoding.encodeInt exponent)
+                        encodedMantissa
+                )
+          where
+            exponent = negate (fromIntegral precision)
+
+            mantissa :: Integer
+            mantissa = truncate (ss * 10 ^ precision)
+
+            encodedMantissa
+                |  fromIntegral (minBound :: Int) <= mantissa
+                && mantissa <= fromIntegral (maxBound :: Int) =
+                    Encoding.encodeInt (fromInteger mantissa)
+                | otherwise =
+                    Encoding.encodeInteger mantissa
+
+        TimeZoneLiteral (Time.TimeZone minutes _ _) ->
+            encodeList4
+                (Encoding.encodeInt 32)
+                (Encoding.encodeBool sign)
+                (Encoding.encodeInt _HH)
+                (Encoding.encodeInt _MM)
+          where
+            sign = 0 <= minutes
+
+            (_HH, _MM) = abs minutes `divMod` 60
+
         Note _ b ->
             go b