ginger 0.3.0.0 → 0.3.2.0

raw patch · 5 files changed

+257/−135 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ginger.cabal +2/−1
• src/Text/Ginger/GVal.hs +96/−62
• src/Text/Ginger/Run.hs +1/−43
• src/Text/Ginger/Run/Builtins.hs +102/−29
• src/Text/Ginger/Run/VM.hs +56/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ginger-version:             0.3.0.0+version:             0.3.2.0 synopsis:            An implementation of the Jinja2 template language in Haskell description:         Ginger is Jinja, minus the most blatant pythonisms. Wants                      to be feature complete, but isn't quite there yet.@@ -29,6 +29,7 @@   other-modules: Text.Ginger.Run.Type                , Text.Ginger.Run.FuncUtils                , Text.Ginger.Run.Builtins+               , Text.Ginger.Run.VM   -- other-extensions:   build-depends: base >=4.5 && <5                , aeson

@@ -69,6 +69,7 @@                  , toGregorian                  , fromGregorian                  , LocalTime (..)+                 , ZonedTime (..)                  , TimeOfDay (..)                  , TimeZone (..)                  , TimeLocale (..)@@ -290,96 +291,119 @@  instance ToGVal m Day where     toGVal x =-        let (year, month, day) = toGregorian x+        let dayDict = dayToDict x             julian = toModifiedJulianDay x             formatted = Text.pack $ formatTime defaultTimeLocale "%0Y-%m-%d" x-        in (orderedDict-            [ "year" ~> year-            , "month" ~> month-            , "day" ~> day-            ])+        in (orderedDict dayDict)             { asHtml = html $ formatted             , asText = formatted             , asBoolean = True             , asNumber = Just . fromIntegral $ julian-            , asList = Just-                [ toGVal year-                , toGVal month-                , toGVal day-                ]+            , asList = Just (List.map snd dayDict)             } +dayToDict :: Day -> [(Text, GVal m)]+dayToDict x =+    let (year, month, day) = toGregorian x+    in [ "year" ~> year+        , "month" ~> month+        , "day" ~> day+        ]+ instance ToGVal m TimeOfDay where     toGVal x =-        let TimeOfDay hours minutes seconds = x+        let timeDict = timeToDict x             formatted = Text.pack $ formatTime defaultTimeLocale "%H:%M:%S" x-        in (orderedDict-            [ "hours" ~> hours-            , "minutes" ~> minutes-            , "seconds" ~> picoToScientific seconds-            ])+        in (orderedDict timeDict)             { asHtml = html $ formatted             , asText = formatted             , asBoolean = True             , asNumber = Nothing-            , asList = Just-                [ toGVal hours-                , toGVal minutes-                , toGVal (picoToScientific seconds)-                ]+            , asList = Just (List.map snd timeDict)             } +timeToDict :: TimeOfDay -> [(Text, GVal m)]+timeToDict (TimeOfDay hours minutes seconds) =+    [ "hours" ~> hours+    , "minutes" ~> minutes+    , "seconds" ~> picoToScientific seconds+    ]+ instance ToGVal m LocalTime where     toGVal x =-        let (year, month, day) = toGregorian $ localDay x-            TimeOfDay hours minutes seconds = localTimeOfDay x+        let dtDict = localTimeToDict x             formatted = Text.pack $ formatTime defaultTimeLocale "%0Y-%m-%d %H:%M:%S" x-        in (orderedDict-            [ "year" ~> year-            , "month" ~> month-            , "day" ~> day-            , "hours" ~> hours-            , "minutes" ~> minutes-            , "seconds" ~> picoToScientific seconds-            , "date" ~> localDay x-            , "time" ~> localTimeOfDay x-            ])+        in (orderedDict $+                dtDict +++                [ "date" ~> localDay x+                , "time" ~> localTimeOfDay x+                ])             { asHtml = html $ formatted             , asText = formatted             , asBoolean = True             , asNumber = Nothing-            , asList = Just-                [ toGVal year-                , toGVal month-                , toGVal day-                , toGVal hours-                , toGVal minutes-                , toGVal (picoToScientific seconds)-                ]+            , asList = Just (List.map snd dtDict)             } +localTimeToDict :: LocalTime -> [(Text, GVal m)]+localTimeToDict x =+        let dayDict = dayToDict $ localDay x+            timeDict = timeToDict $ localTimeOfDay x+        in dayDict ++ timeDict++instance ToGVal m TimeZone where+    toGVal  = dict . timeZoneToDict++timeZoneToDict :: TimeZone -> [(Text, GVal m)]+timeZoneToDict (TimeZone minutes summerOnly name) =+    [ "minutes" ~> minutes+    , "summerOnly" ~> summerOnly+    , "name" ~> name+    ]+ instance ToGVal m TimeLocale where     toGVal t =         let formattedExample =                 Text.pack . formatTime t "%c" $                     LocalTime (fromGregorian 2000 1 1) (TimeOfDay 13 15 00)-        in (dict-            [ "dayNames" ~> wDays t-            , "monthNames" ~> months t-            , "amPm" ~> amPm t-            , "dateTimeFmt" ~> dateTimeFmt t-            , "dateFmt" ~> dateFmt t-            , "timeFmt" ~> timeFmt t-            , "time12Fmt" ~> time12Fmt t-            -- TODO-            -- , "knownTimeZones" ~> knownTimeZones t-            ])+            timeLocaleDict = timeLocaleToDict t+        in (dict timeLocaleDict)             { asHtml = html $ formattedExample             , asText = formattedExample             , asBoolean = True             , asNumber = Nothing             } +timeLocaleToDict :: TimeLocale -> [(Text, GVal m)]+timeLocaleToDict t =+    [ "wDays" ~> List.map packPair (wDays t)+    , "months" ~> List.map packPair (months t)+    , "amPm" ~> packPair (amPm t)+    , "dateTimeFmt" ~> Text.pack (dateTimeFmt t)+    , "dateFmt" ~> Text.pack (dateFmt t)+    , "timeFmt" ~> Text.pack (timeFmt t)+    , "time12Fmt" ~> Text.pack (time12Fmt t)+    -- TODO+    -- , "knownTimeZones" ~> knownTimeZones t+    , "knownTimeZones" ~> ([] :: [Text])+    ]++-- TODO: ToGVal instance for ZonedTime+instance ToGVal m ZonedTime where+    toGVal x =+        let dtDict = zonedTimeToDict x+            formatted = Text.pack $ formatTime defaultTimeLocale "%0Y-%m-%d %H:%M:%S%z" x+        in (dict dtDict)+            { asHtml = html $ formatted+            , asText = formatted+            , asBoolean = True+            , asNumber = Nothing+            }++zonedTimeToDict :: ZonedTime -> [(Text, GVal m)]+zonedTimeToDict t =+    ("tz", toGVal $ zonedTimeZone t):localTimeToDict (zonedTimeToLocalTime t)+ instance (ToGVal m a, ToGVal m b) => ToGVal m (a, b) where     toGVal (a, b) = toGVal ([ toGVal a, toGVal b ] :: [GVal m]) @@ -747,6 +771,12 @@         time <- fromGVal g <|> g ~! "time"         return $ LocalTime date time +instance FromGVal m ZonedTime where+    fromGVal g = do+        localTime <- fromGVal g+        timeZone <- g ~! "tz"+        return $ ZonedTime localTime timeZone+ instance FromGVal m TimeZone where     fromGVal g =         TimeZone@@ -756,15 +786,19 @@  instance FromGVal m TimeLocale where     fromGVal g =-        TimeLocale-            <$> (List.map unpackPair <$> g ~! "dayNames")-            <*> (List.map unpackPair <$> g ~! "monthNames")-            <*> (unpackPair <$> g ~! "amPm")-            <*> (Text.unpack <$> g ~! "dateTimeFmt")-            <*> (Text.unpack <$> g ~! "dateFmt")-            <*> (Text.unpack <$> g ~! "timeFmt")-            <*> (Text.unpack <$> g ~! "time12Fmt")-            <*> (g ~! "knownTimeZones")+        if isDict g+            then+                Just $ TimeLocale+                    (fromMaybe (wDays defaultTimeLocale) $ List.map unpackPair <$> g ~! "wDays")+                    (fromMaybe (months defaultTimeLocale) $ List.map unpackPair <$> g ~! "months")+                    (fromMaybe (amPm defaultTimeLocale) $ unpackPair <$> g ~! "amPm")+                    (fromMaybe (dateTimeFmt defaultTimeLocale) $ Text.unpack <$> g ~! "dateTimeFmt")+                    (fromMaybe (dateFmt defaultTimeLocale) $ Text.unpack <$> g ~! "dateFmt")+                    (fromMaybe (timeFmt defaultTimeLocale) $ Text.unpack <$> g ~! "timeFmt")+                    (fromMaybe (time12Fmt defaultTimeLocale) $ Text.unpack <$> g ~! "time12Fmt")+                    (fromMaybe (knownTimeZones defaultTimeLocale) $ g ~! "knownTimeZones")+            else+                Nothing  pairwise :: (a -> b) -> (a, a) -> (b, b) pairwise f (a, b) = (f a, f b)

@@ -64,6 +64,7 @@ import Text.Ginger.Run.Type import Text.Ginger.Run.Builtins import Text.Ginger.Run.FuncUtils+import Text.Ginger.Run.VM import Text.Printf import Text.PrintfA @@ -291,49 +292,6 @@                     matchArgs' = matchFuncArgs argNames                     (matchedArgs, positionalArgs, namedArgs) = matchArgs' args ---- | Helper function to run a State action with a temporary state, reverting--- to the old state after the action has finished.-withLocalState :: (Monad m, MonadState s m) => m a -> m a-withLocalState a = do-    s <- get-    r <- a-    put s-    return r---- | Helper function to run a Scope action with a temporary scope, reverting--- to the old scope after the action has finished.-withLocalScope :: (Monad m) => Run m h a -> Run m h a-withLocalScope a = do-    scope <- gets rsScope-    r <- a-    modify (\s -> s { rsScope = scope })-    return r--setVar :: Monad m => VarName -> GVal (Run m h) -> Run m h ()-setVar name val = do-    vars <- gets rsScope-    let vars' = HashMap.insert name val vars-    modify (\s -> s { rsScope = vars' })--getVar :: Monad m => VarName -> Run m h (GVal (Run m h))-getVar key = do-    vars <- gets rsScope-    case HashMap.lookup key vars of-        Just val ->-            return val-        Nothing -> do-            l <- asks contextLookup-            l key--clearCapture :: (Monoid h, Monad m) => Run m h ()-clearCapture = modify (\s -> s { rsCapture = mempty })--appendCapture :: (Monoid h, Monad m) => h -> Run m h ()-appendCapture h = modify (\s -> s { rsCapture = rsCapture s <> h })--fetchCapture :: Monad m => Run m h h-fetchCapture = gets rsCapture  -- | Run (evaluate) an expression and return its value into the Run monad runExpression (StringLiteralE str) = return . toGVal $ str

@@ -5,6 +5,7 @@ {-#LANGUAGE TypeSynonymInstances #-} {-#LANGUAGE MultiParamTypeClasses #-} {-#LANGUAGE ScopedTypeVariables #-}+{-#LANGUAGE LambdaCase #-} module Text.Ginger.Run.Builtins where @@ -37,6 +38,7 @@ import Text.Ginger.GVal import Text.Ginger.Run.Type import Text.Ginger.Run.FuncUtils+import Text.Ginger.Run.VM import Text.Printf import Text.PrintfA @@ -62,10 +64,16 @@ import Data.Time ( defaultTimeLocale                  , formatTime                  , LocalTime (..)+                 , ZonedTime (..)+                 , utc+                 , utcToZonedTime+                 , zonedTimeToUTC                  , TimeOfDay (..)                  , fromGregorian                  , Day (..)                  , parseTimeM+                 , TimeLocale (..)+                 , TimeZone (..)                  ) import Data.Foldable (asum) @@ -366,13 +374,13 @@     where         fmtStr = Text.unpack $ asText fmtStrG -gvalToDate :: GVal m -> Maybe LocalTime-gvalToDate g = gvalDictToDate g-             <|> gvalListToDate g-             <|> gvalAutoParseDate g+gvalToDate :: TimeZone -> GVal m -> Maybe ZonedTime+gvalToDate tz g = gvalDictToDate tz g+             <|> gvalListToDate tz g+             <|> gvalAutoParseDate tz g -gvalDictToDate :: GVal m -> Maybe LocalTime-gvalDictToDate g = do+gvalDictToDate :: TimeZone -> GVal m -> Maybe ZonedTime+gvalDictToDate defTZ g = do     let datePartMay = do             year <- fmap (fromIntegral :: Int -> Integer) $ g ~! "year"             month <- g ~! "month"@@ -383,17 +391,19 @@             minutes <- g ~! "minutes"             seconds <- fmap scientificToPico $ g ~! "seconds"             return $ TimeOfDay hours minutes seconds+        tzPartMay = g ~! "tz"     when (isNothing datePartMay && isNothing timePartMay) Nothing     let datePart = fromMaybe (fromGregorian 1970 1 1) datePartMay         timePart = fromMaybe (TimeOfDay 12 0 0) timePartMay-    return $ LocalTime datePart timePart+        tz = fromMaybe defTZ tzPartMay+    return $ ZonedTime (LocalTime datePart timePart) tz -gvalListToDate :: GVal m -> Maybe LocalTime-gvalListToDate g = go =<< asList g+gvalListToDate :: TimeZone -> GVal m -> Maybe ZonedTime+gvalListToDate defTZ g = go =<< asList g     where-        go :: [GVal m] -> Maybe LocalTime+        go :: [GVal m] -> Maybe ZonedTime         go parts = case parts of-            [yearG, monthG, dayG, hoursG, minutesG, secondsG] -> do+            [yearG, monthG, dayG, hoursG, minutesG, secondsG, tzG] -> do                 datePart <-                     fromGregorian                         <$> (fromIntegral <$> toInt yearG)@@ -404,27 +414,44 @@                         <$> toInt hoursG                         <*> toInt minutesG                         <*> (fromIntegral <$> toInt secondsG)-                return $ LocalTime datePart timePart+                tzPart <- fromGVal tzG+                return $ ZonedTime (LocalTime datePart timePart) tzPart+            [yearG, monthG, dayG, hoursG, minutesG, secondsG] ->+                go [yearG, monthG, dayG, hoursG, minutesG, secondsG, toGVal defTZ]             [yearG, monthG, dayG, hoursG, minutesG] ->                 go [yearG, monthG, dayG, hoursG, minutesG, toGVal (0 :: Int)]             [yearG, monthG, dayG] ->                 go [yearG, monthG, dayG, toGVal (12 :: Int), toGVal (0 :: Int)]             _ -> Nothing -gvalAutoParseDate :: GVal m -> Maybe LocalTime-gvalAutoParseDate = go . Text.unpack . asText+gvalAutoParseDate :: TimeZone -> GVal m -> Maybe ZonedTime+gvalAutoParseDate defTZ = go . Text.unpack . asText     where-        go input =-            asum-                . fmap (\fmt -> parseTimeM True defaultTimeLocale fmt input)-                $ formats+        go input = asum [ parse t input | (parse, t) <- formats ]+        ztparse :: String -> String -> Maybe ZonedTime+        ztparse fmt = parseTimeM True defaultTimeLocale fmt+        utcparse :: String -> String -> Maybe ZonedTime+        utcparse fmt input = do+            lt <- parseTimeM True defaultTimeLocale fmt input+            return $ ZonedTime lt defTZ         formats =-            [ "%Y-%m-%d %H:%M:%S"+            [ (ztparse, "%Y-%m-%dT%H:%M:%S%Z")+            , (utcparse, "%Y-%m-%d %H:%M:%S")+            , (ztparse, "%Y-%m-%d %H:%M:%S%z")+            , (ztparse, "%Y-%m-%d %H:%M:%S%Z")+            , (utcparse, "%Y-%m-%d")             ] +gvalToTZ :: GVal m -> Maybe TimeZone+gvalToTZ g =+    fromGVal g <|> (parseTZ . Text.unpack . asText $ g)++parseTZ :: String -> Maybe TimeZone+parseTZ = parseTimeM True defaultTimeLocale "%z"+ gfnDateFormat :: Monad m => Function (Run m h) gfnDateFormat args =-    let Right [gDate, gFormat, gTimeZone, gLocale] =+    let extracted =             extractArgsDefL                 [ ("date", def)                 , ("format", def)@@ -432,15 +459,61 @@                 , ("locale", def)                 ]                 args-        dateMay = gvalToDate gDate-        fmtMay = Text.unpack <$> fromGVal gFormat-    in case fmtMay of-        Just fmt -> do-            let locale = fromMaybe defaultTimeLocale $-                    fromGVal gLocale-            return . toGVal $ formatTime locale fmt <$> dateMay-        Nothing -> do-            return . toGVal $ dateMay+    in case extracted of+        Right [gDate, gFormat, gTimeZone, gLocale] ->+                -- The desired target timezone; Nothing means keep original timezone+            let tzMay = gvalToTZ gTimeZone+                -- The default timezone used when the input doesn't include timezone+                -- information; if a target timezone is given, then it is also used as+                -- the default, otherwise, UTC is assumed. The underlying assumptions+                -- are:+                --+                -- * If the input does not include timezone information, then it is a+                --   local time; hence, if the user explicitly passes a time zone for+                --   formatting, it is assumed that this means the original local time+                --   is in that time zone.+                -- * If the input does not include timezone information, and no+                --   explicit timezone is given, the only sane time zone to pick is+                --   UTC. In this situation, the incoming dates either originate from+                --   a system that doesn't track timezone information but implicitly+                --   stores everything in UTC (which is fine), or the formatting+                --   doesn't use timezone information anyway (in which case it doesn't+                --   matter), or the originator of the data uses another timezone but+                --   fails to report it (in which case it is impossible to do the right+                --   thing)+                -- * If the input *does* include timezone information, it should be+                --   respected; explicitly passing timezone information in the date()+                --   call means the user wants to represent the same zoned time in a+                --   different time zone, which means time zone conversion is required.+                defTZ = fromMaybe utc tzMay+                dateMay = gvalToDate defTZ gDate+                fmtMay = Text.unpack <$> fromGVal gFormat+            in case fmtMay of+                Just fmt -> do+                    locale <- maybe+                        (getTimeLocale gLocale)+                        return+                        (fromGVal gLocale)+                    return . toGVal $ formatTime locale fmt . convertTZ tzMay <$> dateMay+                Nothing -> do+                    return . toGVal $ convertTZ tzMay <$> dateMay+        _ -> fail "Invalid arguments to 'date'"+    where+        convertTZ :: Maybe TimeZone -> ZonedTime -> ZonedTime+        convertTZ Nothing = id+        convertTZ (Just tz) = utcToZonedTime tz . zonedTimeToUTC++getTimeLocale :: Monad m => GVal (Run m h) -> Run m h TimeLocale+getTimeLocale localeName = do+    toFunction <$> getVar "getlocale" >>= \case+        Nothing ->+            return defaultTimeLocale+        Just getlocale -> do+            let args = [ (Just "category", "LC_TIME")+                       , (Just "locale", localeName)+                       ]+            fromMaybe defaultTimeLocale . fromGVal <$> getlocale args+  gfnFilter :: Monad m => Function (Run m h) gfnFilter [] = return def

@@ -0,0 +1,56 @@+module Text.Ginger.Run.VM+where++import Text.Ginger.Run.Type+import Text.Ginger.Run.FuncUtils+import Text.Ginger.AST+import Text.Ginger.GVal+import Data.Monoid ( (<>) )+import Control.Monad.State (MonadState (..), get, gets, modify)+import Control.Monad.Reader (asks)+import qualified Data.HashMap.Strict as HashMap+import Data.HashMap.Strict (HashMap)++-- | Helper function to run a State action with a temporary state, reverting+-- to the old state after the action has finished.+withLocalState :: (Monad m, MonadState s m) => m a -> m a+withLocalState a = do+    s <- get+    r <- a+    put s+    return r++-- | Helper function to run a Scope action with a temporary scope, reverting+-- to the old scope after the action has finished.+withLocalScope :: (Monad m) => Run m h a -> Run m h a+withLocalScope a = do+    scope <- gets rsScope+    r <- a+    modify (\s -> s { rsScope = scope })+    return r++setVar :: Monad m => VarName -> GVal (Run m h) -> Run m h ()+setVar name val = do+    vars <- gets rsScope+    let vars' = HashMap.insert name val vars+    modify (\s -> s { rsScope = vars' })++getVar :: Monad m => VarName -> Run m h (GVal (Run m h))+getVar key = do+    vars <- gets rsScope+    case HashMap.lookup key vars of+        Just val ->+            return val+        Nothing -> do+            l <- asks contextLookup+            l key++clearCapture :: (Monoid h, Monad m) => Run m h ()+clearCapture = modify (\s -> s { rsCapture = mempty })++appendCapture :: (Monoid h, Monad m) => h -> Run m h ()+appendCapture h = modify (\s -> s { rsCapture = rsCapture s <> h })++fetchCapture :: Monad m => Run m h h+fetchCapture = gets rsCapture+