From 3aadd5730bc23d39f765aea99bd2ee38a38f6947 Mon Sep 17 00:00:00 2001 From: Gabriella Gonzalez Date: Mon, 3 Apr 2023 06:50:31 +0200 Subject: [PATCH] Add support for `{Date,Time,TimeZone}/show` (#2493) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit … as standardized in https://github.com/dhall-lang/dhall-lang/pull/1328 --- dhall-bash/src/Dhall/Bash.hs | 3 ++ dhall-json/src/Dhall/JSON.hs | 9 ++++ dhall-nix/src/Dhall/Nix.hs | 8 ++++ dhall/dhall-lang | 2 +- dhall/src/Dhall/Binary.hs | 14 +++++- dhall/src/Dhall/Diff.hs | 18 ++++++++ dhall/src/Dhall/Eval.hs | 64 +++++++++++++++++++++++++++- dhall/src/Dhall/Normalize.hs | 21 +++++++++ dhall/src/Dhall/Parser/Expression.hs | 5 ++- dhall/src/Dhall/Parser/Token.hs | 24 +++++++++++ dhall/src/Dhall/Pretty/Internal.hs | 6 +++ dhall/src/Dhall/Syntax/Expr.hs | 6 +++ dhall/src/Dhall/Syntax/Operations.hs | 6 +++ dhall/src/Dhall/TypeCheck.hs | 9 ++++ dhall/tests/Dhall/Test/QuickCheck.hs | 3 ++ 15 files changed, 193 insertions(+), 5 deletions(-) diff --git a/dhall-bash/src/Dhall/Bash.hs b/dhall-bash/src/Dhall/Bash.hs index d4bfde3d8..756c5532d 100644 --- a/dhall-bash/src/Dhall/Bash.hs +++ b/dhall-bash/src/Dhall/Bash.hs @@ -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) diff --git a/dhall-json/src/Dhall/JSON.hs b/dhall-json/src/Dhall/JSON.hs index 1c80e51e5..9435931db 100644 --- a/dhall-json/src/Dhall/JSON.hs +++ b/dhall-json/src/Dhall/JSON.hs @@ -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 diff --git a/dhall-nix/src/Dhall/Nix.hs b/dhall-nix/src/Dhall/Nix.hs index 79a676ef9..ca6e09a8d 100644 --- a/dhall-nix/src/Dhall/Nix.hs +++ b/dhall-nix/src/Dhall/Nix.hs @@ -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 diff --git a/dhall/dhall-lang b/dhall/dhall-lang index fd057db9b..a3de281a1 160000 --- a/dhall/dhall-lang +++ b/dhall/dhall-lang @@ -1 +1 @@ -Subproject commit fd057db9b3f89de44cdc77d9669e958b04ed416a +Subproject commit a3de281a114c95820ce612bc5383fff717aa507e diff --git a/dhall/src/Dhall/Binary.hs b/dhall/src/Dhall/Binary.hs index 7f45b6a7e..ebe05cddc 100644 --- a/dhall/src/Dhall/Binary.hs +++ b/dhall/src/Dhall/Binary.hs @@ -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 @@ -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 @@ -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" diff --git a/dhall/src/Dhall/Diff.hs b/dhall/src/Dhall/Diff.hs index 68771a51c..10d538d9f 100644 --- a/dhall/src/Dhall/Diff.hs +++ b/dhall/src/Dhall/Diff.hs @@ -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 = diff --git a/dhall/src/Dhall/Eval.hs b/dhall/src/Dhall/Eval.hs index 33a135f53..aac4b0c28 100644 --- a/dhall/src/Dhall/Eval.hs +++ b/dhall/src/Dhall/Eval.hs @@ -46,6 +46,9 @@ module Dhall.Eval ( , Val(..) , (~>) , textShow + , dateShow + , timeShow + , timezoneShow ) where import Data.Bifunctor (first) @@ -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) @@ -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 @@ -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)) @@ -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 -> @@ -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 @@ -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') -> @@ -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 -> @@ -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 -> diff --git a/dhall/src/Dhall/Normalize.hs b/dhall/src/Dhall/Normalize.hs index 8543e1bd4..e6a51a777 100644 --- a/dhall/src/Dhall/Normalize.hs +++ b/dhall/src/Dhall/Normalize.hs @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/dhall/src/Dhall/Parser/Expression.hs b/dhall/src/Dhall/Parser/Expression.hs index a113c338a..45459327e 100644 --- a/dhall/src/Dhall/Parser/Expression.hs +++ b/dhall/src/Dhall/Parser/Expression.hs @@ -722,7 +722,8 @@ parsers embedded = Parsers{..} 'D' -> choice - [ Date <$ _Date + [ DateShow <$ _DateShow + , Date <$ _Date , DoubleShow <$ _DoubleShow , Double <$ _Double ] @@ -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 diff --git a/dhall/src/Dhall/Parser/Token.hs b/dhall/src/Dhall/Parser/Token.hs index 13a0dbbb8..db7e1a629 100644 --- a/dhall/src/Dhall/Parser/Token.hs +++ b/dhall/src/Dhall/Parser/Token.hs @@ -80,8 +80,11 @@ module Dhall.Parser.Token ( _TextReplace, _TextShow, _Date, + _DateShow, _Time, + _TimeShow, _TimeZone, + _TimeZoneShow, _List, _True, _False, @@ -1196,6 +1199,13 @@ _TextShow = builtin "Text/show" _Date :: Parser () _Date = builtin "Date" +{-| Parse the @Date/show@ built-in + + This corresponds to the @Date-show@ rule from the official grammar +-} +_DateShow :: Parser () +_DateShow = builtin "Date/show" + {-| Parse the @Time@ bult-in This corresponds to the @Time@ rule from the official grammar @@ -1203,6 +1213,13 @@ _Date = builtin "Date" _Time :: Parser () _Time = builtin "Time" +{-| Parse the @Time/show@ built-in + + This corresponds to the @Time-show@ rule from the official grammar +-} +_TimeShow :: Parser () +_TimeShow = builtin "Time/show" + {-| Parse the @TimeZone@ bult-in This corresponds to the @TimeZone@ rule from the official grammar @@ -1210,6 +1227,13 @@ _Time = builtin "Time" _TimeZone :: Parser () _TimeZone = builtin "TimeZone" +{-| Parse the @TimeZone/show@ built-in + + This corresponds to the @TimeZone-show@ rule from the official grammar +-} +_TimeZoneShow :: Parser () +_TimeZoneShow = builtin "TimeZone/show" + {-| Parse the @List@ built-in This corresponds to the @List@ rule from the official grammar diff --git a/dhall/src/Dhall/Pretty/Internal.hs b/dhall/src/Dhall/Pretty/Internal.hs index 57aacdb17..aec8cc63c 100644 --- a/dhall/src/Dhall/Pretty/Internal.hs +++ b/dhall/src/Dhall/Pretty/Internal.hs @@ -1343,6 +1343,8 @@ prettyPrinters characterSet = ) where (_HHHH, _MM, _DD) = Time.toGregorian day + prettyPrimitiveExpression DateShow = + builtin "Date/show" prettyPrimitiveExpression Time = builtin "Time" prettyPrimitiveExpression (TimeLiteral (Time.TimeOfDay hh mm seconds) precision) = @@ -1363,6 +1365,8 @@ prettyPrinters characterSet = suffix | precision == 0 = "" | otherwise = "." <> Pretty.pretty (Printf.printf "%0*d" precision fraction :: String) + prettyPrimitiveExpression TimeShow = + builtin "Time/show" prettyPrimitiveExpression TimeZone = builtin "TimeZone" prettyPrimitiveExpression (TimeZoneLiteral (Time.TimeZone minutes _ _)) = @@ -1376,6 +1380,8 @@ prettyPrinters characterSet = sign = if 0 <= minutes then "+" else "-" (_HH, _MM) = abs minutes `divMod` 60 + prettyPrimitiveExpression TimeZoneShow = + builtin "TimeZone/show" prettyPrimitiveExpression List = builtin "List" prettyPrimitiveExpression ListBuild = diff --git a/dhall/src/Dhall/Syntax/Expr.hs b/dhall/src/Dhall/Syntax/Expr.hs index d17f04e57..6398ff019 100644 --- a/dhall/src/Dhall/Syntax/Expr.hs +++ b/dhall/src/Dhall/Syntax/Expr.hs @@ -147,6 +147,8 @@ data Expr s a | Date -- | > DateLiteral (fromGregorian _YYYY _MM _DD) ~ YYYY-MM-DD | DateLiteral Time.Day + -- | > DateShow ~ Date/show + | DateShow -- | > Time ~ Time | Time -- | > TimeLiteral (TimeOfDay hh mm ss) _ ~ hh:mm:ss @@ -154,11 +156,15 @@ data Expr s a Time.TimeOfDay Word -- ^ Precision + -- | > TimeShow ~ Time/show + | TimeShow -- | > TimeZone ~ TimeZone | TimeZone -- | > TimeZoneLiteral (TimeZone ( 60 * _HH + _MM) _ _) ~ +HH:MM -- | > TimeZoneLiteral (TimeZone (-60 * _HH + _MM) _ _) ~ -HH:MM | TimeZoneLiteral Time.TimeZone + -- | > TimeZoneShow ~ TimeZone/Show + | TimeZoneShow -- | > List ~ List | List -- | > ListLit (Just t ) [] ~ [] : t diff --git a/dhall/src/Dhall/Syntax/Operations.hs b/dhall/src/Dhall/Syntax/Operations.hs index d2175af7f..f98abd9d7 100644 --- a/dhall/src/Dhall/Syntax/Operations.hs +++ b/dhall/src/Dhall/Syntax/Operations.hs @@ -113,10 +113,13 @@ unsafeSubExpressions _ TextReplace = pure TextReplace unsafeSubExpressions _ TextShow = pure TextShow unsafeSubExpressions _ Date = pure Date unsafeSubExpressions _ (DateLiteral a) = pure (DateLiteral a) +unsafeSubExpressions _ DateShow = pure DateShow unsafeSubExpressions _ Time = pure Time unsafeSubExpressions _ (TimeLiteral a b) = pure (TimeLiteral a b) +unsafeSubExpressions _ TimeShow = pure TimeShow unsafeSubExpressions _ TimeZone = pure TimeZone unsafeSubExpressions _ (TimeZoneLiteral a) = pure (TimeZoneLiteral a) +unsafeSubExpressions _ TimeZoneShow = pure TimeZoneShow unsafeSubExpressions _ List = pure List unsafeSubExpressions f (ListLit a b) = ListLit <$> traverse f a <*> traverse f b unsafeSubExpressions f (ListAppend a b) = ListAppend <$> f a <*> f b @@ -256,6 +259,9 @@ reservedIdentifiers = reservedKeywords <> , "List/reverse" , "Text/replace" , "Text/show" + , "Date/show" + , "Time/show" + , "TimeZone/show" , "Bool" , "Bytes" , "True" diff --git a/dhall/src/Dhall/TypeCheck.hs b/dhall/src/Dhall/TypeCheck.hs index f2a800de9..00e249437 100644 --- a/dhall/src/Dhall/TypeCheck.hs +++ b/dhall/src/Dhall/TypeCheck.hs @@ -589,18 +589,27 @@ infer typer = loop DateLiteral _ -> return VDate + DateShow -> + return (VDate ~> VText) + Time -> return (VConst Type) TimeLiteral _ _ -> return VTime + TimeShow -> + return (VTime ~> VText) + TimeZone -> return (VConst Type) TimeZoneLiteral _ -> return VTimeZone + TimeZoneShow -> + return (VTimeZone ~> VText) + List -> return (VConst Type ~> VConst Type) diff --git a/dhall/tests/Dhall/Test/QuickCheck.hs b/dhall/tests/Dhall/Test/QuickCheck.hs index 5a2beb6cf..110a1692d 100644 --- a/dhall/tests/Dhall/Test/QuickCheck.hs +++ b/dhall/tests/Dhall/Test/QuickCheck.hs @@ -388,10 +388,13 @@ instance (Arbitrary s, Arbitrary a) => Arbitrary (Expr s a) where % (1 :: W "TextShow") % (1 :: W "Date") % (1 :: W "DateLiteral") + % (1 :: W "DateShow") % (1 :: W "Time") % (1 :: W "TimeLiteral") + % (1 :: W "TimeShow") % (1 :: W "TimeZone") % (1 :: W "TimeZoneLiteral") + % (1 :: W "TimeZoneShow") % (1 :: W "List") % (1 :: W "ListLit") % (1 :: W "ListAppend")