Add Date and Time component extraction builtins

dhall-bash/src/Dhall/Bash.hs

@@ -320,9 +320,15 @@ dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
     go e@(Date               ) = Left (UnsupportedStatement e)
     go e@(DateLiteral      {}) = Left (UnsupportedStatement e)
     go e@(DateShow           ) = Left (UnsupportedStatement e)
+    go e@(DateYear           ) = Left (UnsupportedStatement e)
+    go e@(DateMonth          ) = Left (UnsupportedStatement e)
+    go e@(DateDay            ) = Left (UnsupportedStatement e)
     go e@(Time               ) = Left (UnsupportedStatement e)
     go e@(TimeLiteral      {}) = Left (UnsupportedStatement e)
     go e@(TimeShow           ) = Left (UnsupportedStatement e)
+    go e@(TimeHour           ) = Left (UnsupportedStatement e)
+    go e@(TimeMinute         ) = Left (UnsupportedStatement e)
+    go e@(TimeSecond         ) = Left (UnsupportedStatement e)
     go e@(TimeZone           ) = Left (UnsupportedStatement e)
     go e@(TimeZoneLiteral  {}) = Left (UnsupportedStatement e)
     go e@(TimeZoneShow       ) = Left (UnsupportedStatement e)

dhall-json/src/Dhall/JSON.hs

@@ -900,6 +900,15 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
         Core.DateShow ->
             Core.DateShow
 
+        Core.DateYear ->
+            Core.DateYear
+
+        Core.DateMonth ->
+            Core.DateMonth
+
+        Core.DateDay ->
+            Core.DateDay
+
         Core.Time ->
             Core.Time
 
@@ -909,6 +918,15 @@ convertToHomogeneousMaps (Conversion {..}) e0 = loop (Core.normalize e0)
         Core.TimeShow ->
             Core.TimeShow
 
+        Core.TimeHour ->
+            Core.TimeHour
+
+        Core.TimeMinute ->
+            Core.TimeMinute
+
+        Core.TimeSecond ->
+            Core.TimeSecond
+
         Core.TimeZone ->
             Core.TimeZone
 

dhall-nix/src/Dhall/Nix.hs

@@ -105,6 +105,7 @@ import Data.Void (Void, absurd)
 import Lens.Micro (toListOf, rewriteOf)
 import Numeric (showHex)
 import Data.Char (ord, isDigit, isAsciiLower, isAsciiUpper)
+import Data.String (fromString)
 
 import Dhall.Core
     ( Binding (..)
@@ -336,6 +337,19 @@ dhallToNix e =
     rewriteShadowed =
         rewriteOf Dhall.Core.subExpressions renameShadowed
 
+    -- Template of a Nix function that extracts a substring using regex
+    -- and parses the result as an integer
+    regexSubstrToInt argName regex =
+        (fromString argName)
+        ==> ( "builtins.fromJSON"
+            @@ ( "builtins.head"
+               @@ ( "builtins.match"
+                  @@ (Nix.mkStr regex)
+                  @@ (fromString argName)
+                  )
+               )
+            )
+
     loop (Const _) = return untranslatable
     loop (Var (V a 0)) = return (Nix.mkSym (zEncodeSymbol a))
     loop (Var  a     ) = Left (CannotReferenceShadowedVariable a)
@@ -607,13 +621,27 @@ dhallToNix e =
     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
+    -- so the corresponding show functions are the identity function, and the
+    -- functions extracting the year/month/day and hour/minute/second components
+    -- find the corresponding substring and parse it as an integer.
     loop DateShow =
         return ("date" ==> "date")
     loop TimeShow =
         return ("time" ==> "time")
     loop TimeZoneShow =
         return ("timeZone" ==> "timeZone")
+    loop DateYear =
+        return (regexSubstrToInt "date" "0*([0-9]+)-[0-9]{2}-[0-9]{2}")
+    loop DateMonth =
+        return (regexSubstrToInt "date" "[0-9]{4}-0?([0-9]+)-[0-9]{2}")
+    loop DateDay =
+        return (regexSubstrToInt "date" "[0-9]{4}-[0-9]{2}-0?([0-9]+)")
+    loop TimeHour =
+        return (regexSubstrToInt "time" "0?([0-9]+):[0-9]{2}:[0-9]{2}.*")
+    loop TimeMinute =
+        return (regexSubstrToInt "time" "[0-9]{2}:0?([0-9]+):[0-9]{2}.*")
+    loop TimeSecond =
+        return (regexSubstrToInt "time" "[0-9]{2}:[0-9]{2}:0?([0-9]+).*")
     loop (Record _) = return untranslatable
     loop (RecordLit a) = do
         a' <- traverse (loop . Dhall.Core.recordFieldValue) a

dhall/src/Dhall/Binary.hs

@@ -150,16 +150,22 @@ decodeExpressionInternal decodeEmbed = go
                        | sb == "Natural"           -> return Natural
                     8  | sb == "Optional"          -> return Optional
                        | sb == "TimeZone"          -> return TimeZone
+                       | sb == "Date/day"          -> return DateDay
                     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
+                       | sb == "Date/year"         -> return DateYear
+                       | sb == "Time/hour"         -> return TimeHour
                     10 | sb == "List/build"        -> return ListBuild
+                       | sb == "Date/month"        -> return DateMonth
                     11 | sb == "Double/show"       -> return DoubleShow
                        | sb == "List/length"       -> return ListLength
                        | sb == "Natural/odd"       -> return NaturalOdd
+                       | sb == "Time/minute"       -> return TimeMinute
+                       | sb == "Time/second"       -> return TimeSecond
                     12 | sb == "Integer/show"      -> return IntegerShow
                        | sb == "List/indexed"      -> return ListIndexed
                        | sb == "List/reverse"      -> return ListReverse
@@ -780,12 +786,30 @@ encodeExpressionInternal encodeEmbed = go
         DateShow ->
             Encoding.encodeUtf8ByteArray "Date/show"
 
+        DateYear ->
+            Encoding.encodeUtf8ByteArray "Date/year"
+
+        DateMonth ->
+            Encoding.encodeUtf8ByteArray "Date/month"
+
+        DateDay ->
+            Encoding.encodeUtf8ByteArray "Date/day"
+
         Time ->
             Encoding.encodeUtf8ByteArray "Time"
 
         TimeShow ->
             Encoding.encodeUtf8ByteArray "Time/show"
 
+        TimeHour ->
+            Encoding.encodeUtf8ByteArray "Time/hour"
+
+        TimeMinute ->
+            Encoding.encodeUtf8ByteArray "Time/minute"
+
+        TimeSecond ->
+            Encoding.encodeUtf8ByteArray "Time/second"
+
         TimeZone ->
             Encoding.encodeUtf8ByteArray "TimeZone"
 

dhall/src/Dhall/Diff.hs

@@ -1316,6 +1316,24 @@ diffPrimitiveExpression l r@DateShow =
     mismatch l r
 diffPrimitiveExpression l@DateShow r=
     mismatch l r
+diffPrimitiveExpression DateYear DateYear =
+    "…"
+diffPrimitiveExpression l r@DateYear =
+    mismatch l r
+diffPrimitiveExpression l@DateYear r=
+    mismatch l r
+diffPrimitiveExpression DateMonth DateMonth =
+    "…"
+diffPrimitiveExpression l r@DateMonth =
+    mismatch l r
+diffPrimitiveExpression l@DateMonth r=
+    mismatch l r
+diffPrimitiveExpression DateDay DateDay =
+    "…"
+diffPrimitiveExpression l r@DateDay =
+    mismatch l r
+diffPrimitiveExpression l@DateDay r=
+    mismatch l r
 diffPrimitiveExpression Time Time =
     "…"
 diffPrimitiveExpression l r@Time =
@@ -1328,6 +1346,24 @@ diffPrimitiveExpression l r@TimeShow =
     mismatch l r
 diffPrimitiveExpression l@TimeShow r=
     mismatch l r
+diffPrimitiveExpression TimeHour TimeHour =
+    "…"
+diffPrimitiveExpression l r@TimeHour =
+    mismatch l r
+diffPrimitiveExpression l@TimeHour r=
+    mismatch l r
+diffPrimitiveExpression TimeMinute TimeMinute =
+    "…"
+diffPrimitiveExpression l r@TimeMinute =
+    mismatch l r
+diffPrimitiveExpression l@TimeMinute r=
+    mismatch l r
+diffPrimitiveExpression TimeSecond TimeSecond =
+    "…"
+diffPrimitiveExpression l r@TimeSecond =
+    mismatch l r
+diffPrimitiveExpression l@TimeSecond r=
+    mismatch l r
 diffPrimitiveExpression TimeZone TimeZone =
     "…"
 diffPrimitiveExpression l r@TimeZone =

dhall/src/Dhall/Eval.hs

@@ -49,6 +49,12 @@ module Dhall.Eval (
   , dateShow
   , timeShow
   , timezoneShow
+  , getYear
+  , getMonth
+  , getDay
+  , getHour
+  , getMinute
+  , getSecond
   ) where
 
 import Data.Bifunctor     (first)
@@ -211,9 +217,15 @@ data Val a
     | VDate
     | VDateLiteral Time.Day
     | VDateShow !(Val a)
+    | VDateYear !(Val a)
+    | VDateMonth !(Val a)
+    | VDateDay !(Val a)
     | VTime
     | VTimeLiteral Time.TimeOfDay Word
     | VTimeShow !(Val a)
+    | VTimeHour !(Val a)
+    | VTimeMinute !(Val a)
+    | VTimeSecond !(Val a)
     | VTimeZone
     | VTimeZoneLiteral Time.TimeZone
     | VTimeZoneShow !(Val a)
@@ -681,6 +693,18 @@ eval !env t0 =
             VPrim $ \case
                 VDateLiteral d -> VTextLit (VChunks [] (dateShow d))
                 t              -> VDateShow t
+        DateYear ->
+            VPrim $ \case
+                VDateLiteral d -> VNaturalLit (getYear d)
+                t -> VDateYear t
+        DateMonth ->
+            VPrim $ \case
+                VDateLiteral d -> VNaturalLit (getMonth d)
+                t -> VDateMonth t
+        DateDay ->
+            VPrim $ \case
+                VDateLiteral d -> VNaturalLit (getDay d)
+                t -> VDateDay t
         Time ->
             VTime
         TimeLiteral t p ->
@@ -689,6 +713,18 @@ eval !env t0 =
             VPrim $ \case
                 VTimeLiteral d p -> VTextLit (VChunks [] (timeShow d p))
                 t                -> VTimeShow t
+        TimeHour ->
+            VPrim $ \case
+                VTimeLiteral d _ -> VNaturalLit (getHour d)
+                t                -> VTimeHour t
+        TimeMinute ->
+            VPrim $ \case
+                VTimeLiteral d _ -> VNaturalLit (getMinute d)
+                t                -> VTimeMinute t
+        TimeSecond ->
+            VPrim $ \case
+                VTimeLiteral d _ -> VNaturalLit (getSecond d)
+                t                -> VTimeSecond t
         TimeZone ->
             VTimeZone
         TimeZoneLiteral z ->
@@ -946,6 +982,30 @@ timeShow (TimeOfDay hh mm seconds) precision =
 timezoneShow :: TimeZone -> Text
 timezoneShow = Text.pack . Time.formatTime Time.defaultTimeLocale "%Ez"
 
+-- | Utility that powers the @Date/year@ built-in
+getYear :: Day -> Natural
+getYear = fromIntegral . (\(y,_,_) -> y) . Time.toGregorian
+
+-- | Utility that powers the @Date/month@ built-in
+getMonth :: Day -> Natural
+getMonth = fromIntegral . (\(_,m,_) -> m) . Time.toGregorian
+
+-- | Utility that powers the @Date/day@ built-in
+getDay :: Day -> Natural
+getDay = fromIntegral . (\(_,_,d) -> d) . Time.toGregorian
+
+-- | Utility that powers the @Time/hour@ built-in
+getHour :: TimeOfDay -> Natural
+getHour (TimeOfDay h _ _) = fromIntegral h
+
+-- | Utility that powers the @Time/minute@ built-in
+getMinute :: TimeOfDay -> Natural
+getMinute (TimeOfDay _ m _) = fromIntegral m
+
+-- | Utility that powers the @Time/second@ built-in
+getSecond :: TimeOfDay -> Natural
+getSecond (TimeOfDay _ _ picoseconds) = floor picoseconds
+
 conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool
 conv !env t0 t0' =
     case (t0, t0') of
@@ -1055,12 +1115,24 @@ conv !env t0 t0' =
             l == r
         (VDateShow t, VDateShow t') ->
             conv env t t'
+        (VDateYear t, VDateYear t') ->
+            conv env t t'
+        (VDateMonth t, VDateMonth t') ->
+            conv env t t'
+        (VDateDay t, VDateDay 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'
+        (VTimeHour t, VTimeHour t') ->
+            conv env t t'
+        (VTimeMinute t, VTimeMinute t') ->
+            conv env t t'
+        (VTimeSecond t, VTimeSecond t') ->
+            conv env t t'
         (VTimeZone, VTimeZone) ->
             True
         (VTimeZoneLiteral l, VTimeZoneLiteral r) ->
@@ -1277,12 +1349,24 @@ quote !env !t0 =
             DateLiteral d
         VDateShow t ->
             DateShow `qApp` t
+        VDateYear t ->
+            DateYear `qApp` t
+        VDateMonth t ->
+            DateMonth `qApp` t
+        VDateDay t ->
+            DateDay `qApp` t
         VTime ->
             Time
         VTimeLiteral t p ->
             TimeLiteral t p
         VTimeShow t ->
             TimeShow `qApp` t
+        VTimeHour t ->
+            TimeHour `qApp` t
+        VTimeMinute t ->
+            TimeMinute `qApp` t
+        VTimeSecond t ->
+            TimeSecond `qApp` t
         VTimeZone ->
             TimeZone
         VTimeZoneLiteral z ->
@@ -1486,12 +1570,24 @@ alphaNormalize = goEnv EmptyNames
                 DateLiteral d
             DateShow ->
                 DateShow
+            DateYear ->
+                DateYear
+            DateMonth ->
+                DateMonth
+            DateDay ->
+                DateDay
             Time ->
                 Time
             TimeLiteral t p ->
                 TimeLiteral t p
             TimeShow ->
                 TimeShow
+            TimeHour ->
+                TimeHour
+            TimeMinute ->
+                TimeMinute
+            TimeSecond ->
+                TimeSecond
             TimeZone ->
                 TimeZone
             TimeZoneLiteral z ->