ginger 0.2.8.0 → 0.3.0.0

raw patch · 4 files changed

+407/−40 lines, 4 filesdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: time

API changes (from Hackage documentation)

Files

• ginger.cabal +3/−1
• src/Text/Ginger/GVal.hs +317/−39
• src/Text/Ginger/Run.hs +2/−0
• src/Text/Ginger/Run/Builtins.hs +85/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ginger-version:             0.2.8.0+version:             0.3.0.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.@@ -41,6 +41,7 @@                , safe >= 0.3                , scientific >= 0.3                , text+               , time                , transformers >= 0.3                , unordered-containers >= 0.2.5                , utf8-string@@ -76,6 +77,7 @@                  , tasty-hunit                  , tasty-quickcheck                  , text+                 , time                  , transformers                  , unordered-containers >= 0.2.5                  , utf8-string

@@ -18,7 +18,7 @@  import Prelude ( (.), ($), (==), (/=)                , (++), (+), (-), (*), (/), div-               , (>>=), return+               , (=<<), (>>=), return                , undefined, otherwise, id, const                , Maybe (..)                , Bool (..)@@ -46,8 +46,12 @@ import Data.Scientific ( Scientific                        , floatingOrInteger                        , toBoundedInteger-                       , toRealFloat +                       , toRealFloat+                       , scientific+                       , coefficient+                       , base10Exponent                        )+import Data.Fixed (Fixed (..), Pico) import Control.Applicative import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as HashMap@@ -58,6 +62,17 @@ import Data.Default (Default, def) import Text.Printf import Debug.Trace (trace)+import Data.Time ( Day (..)+                 , defaultTimeLocale+                 , toModifiedJulianDay+                 , formatTime+                 , toGregorian+                 , fromGregorian+                 , LocalTime (..)+                 , TimeOfDay (..)+                 , TimeZone (..)+                 , TimeLocale (..)+                 )  import Text.Ginger.Html @@ -273,6 +288,98 @@             , isNull = False             } +instance ToGVal m Day where+    toGVal x =+        let (year, month, day) = toGregorian x+            julian = toModifiedJulianDay x+            formatted = Text.pack $ formatTime defaultTimeLocale "%0Y-%m-%d" x+        in (orderedDict+            [ "year" ~> year+            , "month" ~> month+            , "day" ~> day+            ])+            { asHtml = html $ formatted+            , asText = formatted+            , asBoolean = True+            , asNumber = Just . fromIntegral $ julian+            , asList = Just+                [ toGVal year+                , toGVal month+                , toGVal day+                ]+            }++instance ToGVal m TimeOfDay where+    toGVal x =+        let TimeOfDay hours minutes seconds = x+            formatted = Text.pack $ formatTime defaultTimeLocale "%H:%M:%S" x+        in (orderedDict+            [ "hours" ~> hours+            , "minutes" ~> minutes+            , "seconds" ~> picoToScientific seconds+            ])+            { asHtml = html $ formatted+            , asText = formatted+            , asBoolean = True+            , asNumber = Nothing+            , asList = Just+                [ toGVal hours+                , toGVal minutes+                , toGVal (picoToScientific seconds)+                ]+            }++instance ToGVal m LocalTime where+    toGVal x =+        let (year, month, day) = toGregorian $ localDay x+            TimeOfDay hours minutes seconds = localTimeOfDay 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+            ])+            { asHtml = html $ formatted+            , asText = formatted+            , asBoolean = True+            , asNumber = Nothing+            , asList = Just+                [ toGVal year+                , toGVal month+                , toGVal day+                , toGVal hours+                , toGVal minutes+                , toGVal (picoToScientific seconds)+                ]+            }++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+            ])+            { asHtml = html $ formattedExample+            , asText = formattedExample+            , asBoolean = True+            , asNumber = Nothing+            }+ instance (ToGVal m a, ToGVal m b) => ToGVal m (a, b) where     toGVal (a, b) = toGVal ([ toGVal a, toGVal b ] :: [GVal m]) @@ -282,43 +389,6 @@ instance (ToGVal m a, ToGVal m b, ToGVal m c, ToGVal m d) => ToGVal m (a, b, c, d) where     toGVal (a, b, c, d) = toGVal ([ toGVal a, toGVal b, toGVal c, toGVal d ] :: [GVal m]) --- * Convenience API for constructing heterogenous dictionaries.------ Example usage:------ > context :: GVal m--- > context = dict [ "number" ~> (15 :: Int), "name" ~> ("Joe" :: String) ]---- | A key/value pair, used for constructing dictionary GVals using a--- compact syntax.-type Pair m = (Text, GVal m)---- | Construct a dictionary GVal from a list of pairs. Internally, this uses--- a hashmap, so element order will not be preserved.-dict :: [Pair m] -> GVal m-dict = toGVal . HashMap.fromList---- | Construct an ordered dictionary GVal from a list of pairs. Internally,--- this conversion uses both a hashmap (for O(1) lookup) and the original list,--- so element order is preserved, but there is a bit of a memory overhead.-orderedDict :: [Pair m] -> GVal m-orderedDict xs =-    def-        { asHtml = mconcat . Prelude.map (asHtml . snd) $ xs-        , asText = mconcat . Prelude.map (asText . snd) $ xs-        , asBoolean = not . Prelude.null $ xs-        , isNull = False-        , asLookup = Just (`HashMap.lookup` hm)-        , asDictItems = Just xs-        }-    where-        hm = HashMap.fromList xs---- | Construct a pair from a key and a value.-(~>) :: ToGVal m a => Text -> a -> Pair m-k ~> v = (k, toGVal v)-infixr 8 ~>- -- | Silly helper function, needed to bypass the default 'Show' instance of -- 'Scientific' in order to make integral 'Scientific's look like integers. scientificToText :: Scientific -> Text@@ -429,6 +499,66 @@         }  +-- * Convenience API for constructing heterogenous dictionaries.+--+-- Example usage:+--+-- > context :: GVal m+-- > context = dict [ "number" ~> (15 :: Int), "name" ~> ("Joe" :: String) ]++-- | A key/value pair, used for constructing dictionary GVals using a+-- compact syntax.+type Pair m = (Text, GVal m)++-- | Construct a dictionary GVal from a list of pairs. Internally, this uses+-- a hashmap, so element order will not be preserved.+dict :: [Pair m] -> GVal m+dict = toGVal . HashMap.fromList++-- | Construct an ordered dictionary GVal from a list of pairs. Internally,+-- this conversion uses both a hashmap (for O(1) lookup) and the original list,+-- so element order is preserved, but there is a bit of a memory overhead.+orderedDict :: [Pair m] -> GVal m+orderedDict xs =+    def+        { asHtml = mconcat . Prelude.map (asHtml . snd) $ xs+        , asText = mconcat . Prelude.map (asText . snd) $ xs+        , asBoolean = not . Prelude.null $ xs+        , isNull = False+        , asLookup = Just (`HashMap.lookup` hm)+        , asDictItems = Just xs+        }+    where+        hm = HashMap.fromList xs++-- | Construct a pair from a key and a value.+(~>) :: ToGVal m a => Text -> a -> Pair m+k ~> v = (k, toGVal v)+infixr 8 ~>++-- * Convenience API for constructing heterogenous lists++type Cons m = [GVal m]++-- | Alias for '(~:)'.+gcons :: ToGVal m a => a -> Cons m -> Cons m+gcons = (:) . toGVal++-- | This operator allows constructing heterogenous lists using cons-style+-- syntax, e.g.:+--+-- >>> asText $ list ("Found " ~: (6 :: Int) ~: " items" ~: [] :: [GVal IO])+-- "Found 6 items"+(~:) :: ToGVal m a => a -> Cons m -> Cons m+(~:) = gcons+infixr 5 ~:++-- | Construct a GVal from a list of GVals. This is equivalent to the 'toGVal'+-- implementation of @[GVal m]@, but typed more narrowly for clarity and+-- disambiguation.+list :: Cons m -> GVal m+list = toGVal+ -- * Inspecting 'GVal's / Marshalling 'GVal' to Haskell  -- | Check if the given GVal is a list-like object@@ -468,6 +598,15 @@ lookupLoose k v =     lookupKey (asText k) v <|> lookupIndexMay (floor <$> asNumber k) v +-- | Like 'lookupLoose', but fall back to the given default value if+-- the key is not in the dictionary, or if the indexee is not a+-- dictionary-like object.+lookupLooseDef :: GVal m -> GVal m -> GVal m -> GVal m+lookupLooseDef d k = fromMaybe d . lookupLoose k++(~!) :: (FromGVal m v) => GVal m -> GVal m -> Maybe v+g ~! k = lookupLoose k g >>= fromGVal+ -- | Treat a 'GVal' as a dictionary and list all the keys, with no particular -- ordering. keys :: GVal m -> Maybe [Text]@@ -483,6 +622,16 @@ toInt :: GVal m -> Maybe Int toInt x = toNumber x >>= toBoundedInteger +-- | Convert a 'GVal' to an 'Int', falling back to the given+-- default if the conversion fails.+toIntDef :: Int -> GVal m -> Int+toIntDef d = fromMaybe d . toInt++-- | Convert a 'GVal' to an 'Int', falling back to zero (0)+-- if the conversion fails.+toInt0 :: GVal m -> Int+toInt0 = toIntDef 0+ -- | Loose cast to boolean. -- -- Numeric zero, empty strings, empty lists, empty objects, 'Null', and boolean@@ -496,3 +645,132 @@ -- it's not. toFunction :: GVal m -> Maybe (Function m) toFunction = asFunction++picoToScientific :: Pico -> Scientific+picoToScientific (MkFixed x) = scientific x (-12)++scientificToPico :: Scientific -> Pico+scientificToPico s =+    MkFixed (Prelude.floor $ scientific (coefficient s) (base10Exponent s + 12))++class FromGVal m a where+    fromGValEither :: GVal m -> Either Prelude.String a+    fromGValEither = Prelude.maybe (Left "Conversion from GVal failed") Right . fromGVal+    fromGVal :: GVal m -> Maybe a+    fromGVal = Prelude.either (const Nothing) Just . fromGValEither++fromGValM :: (Monad m, FromGVal m a) => GVal m -> m a+fromGValM = Prelude.either Prelude.fail return . fromGValEither++instance FromGVal m Int where+    fromGVal = toInt++instance FromGVal m Scientific where+    fromGVal = asNumber++instance FromGVal m Text where+    fromGVal = Just . asText++instance FromGVal m (GVal m) where+    fromGVal = Just++instance FromGVal m a => FromGVal m (Maybe a) where+    fromGVal = \g ->+        if isNull g+            then+                Just Nothing+            else+                Just <$> fromGVal g++instance FromGVal m Bool where+    fromGVal = Just . asBoolean++instance FromGVal m JSON.Value where+    fromGVal = asJSON++instance FromGVal m () where+    fromGVal g = if isNull g then Just () else Nothing++instance FromGVal m a => FromGVal m [a] where+    fromGVal g = asList g >>= mapM fromGVal++instance ( FromGVal m a+         , FromGVal m b+         ) => FromGVal m (a, b) where+    fromGVal g = case asList g of+        Just [a, b] ->+            (,) <$> fromGVal a+                <*> fromGVal b+        _ -> Nothing++instance ( FromGVal m a+         , FromGVal m b+         , FromGVal m c+         ) => FromGVal m (a, b, c) where+    fromGVal g = case asList g of+        Just [a, b, c] ->+            (,,) <$> fromGVal a+                 <*> fromGVal b+                 <*> fromGVal c+        _ -> Nothing++instance ( FromGVal m a+         , FromGVal m b+         , FromGVal m c+         , FromGVal m d+         ) => FromGVal m (a, b, c, d) where+    fromGVal g = case asList g of+        Just [a, b, c, d] ->+            (,,,) <$> fromGVal a+                  <*> fromGVal b+                  <*> fromGVal c+                  <*> fromGVal d+        _ -> Nothing++instance FromGVal m Day where+    fromGVal g = do+        year <- fromIntegral <$> (g ~! "year" :: Maybe Int)+        month <- g ~! "month"+        day <- g ~! "day"+        return $ fromGregorian year month day++instance FromGVal m TimeOfDay where+    fromGVal g = do+        hours <- g ~! "hours"+        minutes <- g ~! "minutes"+        seconds <- scientificToPico <$> g ~! "seconds"+        return $ TimeOfDay hours minutes seconds++instance FromGVal m LocalTime where+    fromGVal g = do+        date <- fromGVal g <|> g ~! "date"+        time <- fromGVal g <|> g ~! "time"+        return $ LocalTime date time++instance FromGVal m TimeZone where+    fromGVal g =+        TimeZone+            <$> g ~! "minutes"+            <*> g ~! "summerOnly"+            <*> (Text.unpack <$> g ~! "name")++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")++pairwise :: (a -> b) -> (a, a) -> (b, b)+pairwise f (a, b) = (f a, f b)++packPair :: ([Char], [Char]) -> (Text, Text)+packPair = pairwise Text.pack++unpackPair :: (Text, Text) -> ([Char], [Char])+unpackPair = pairwise Text.unpack

@@ -100,6 +100,8 @@     , ("concat", fromFunction . variadicStringFunc $ mconcat)     , ("contains", fromFunction gfnContains)     , ("d", fromFunction gfnDefault)+    , ("date", fromFunction gfnDateFormat)+    , ("dateformat", fromFunction gfnDateFormat)     , ("default", fromFunction gfnDefault)     , ("difference", fromFunction . variadicNumericFunc 0 $ difference)     , ("e", fromFunction gfnEscape)

@@ -59,6 +59,15 @@ import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) import Data.List (lookup, zipWith, unzip)+import Data.Time ( defaultTimeLocale+                 , formatTime+                 , LocalTime (..)+                 , TimeOfDay (..)+                 , fromGregorian+                 , Day (..)+                 , parseTimeM+                 )+import Data.Foldable (asum)  gfnRawHtml :: Monad m => Function (Run m h) gfnRawHtml = unaryFunc (toGVal . unsafeRawHtml . asText)@@ -356,6 +365,82 @@     return . toGVal $ printfG fmtStr (fmap snd args)     where         fmtStr = Text.unpack $ asText fmtStrG++gvalToDate :: GVal m -> Maybe LocalTime+gvalToDate g = gvalDictToDate g+             <|> gvalListToDate g+             <|> gvalAutoParseDate g++gvalDictToDate :: GVal m -> Maybe LocalTime+gvalDictToDate g = do+    let datePartMay = do+            year <- fmap (fromIntegral :: Int -> Integer) $ g ~! "year"+            month <- g ~! "month"+            day <- g ~! "day"+            return $ fromGregorian year month day+        timePartMay = do+            hours <- g ~! "hours"+            minutes <- g ~! "minutes"+            seconds <- fmap scientificToPico $ g ~! "seconds"+            return $ TimeOfDay hours minutes seconds+    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++gvalListToDate :: GVal m -> Maybe LocalTime+gvalListToDate g = go =<< asList g+    where+        go :: [GVal m] -> Maybe LocalTime+        go parts = case parts of+            [yearG, monthG, dayG, hoursG, minutesG, secondsG] -> do+                datePart <-+                    fromGregorian+                        <$> (fromIntegral <$> toInt yearG)+                        <*> toInt monthG+                        <*> toInt dayG+                timePart <-+                    TimeOfDay+                        <$> toInt hoursG+                        <*> toInt minutesG+                        <*> (fromIntegral <$> toInt secondsG)+                return $ LocalTime datePart timePart+            [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+    where+        go input =+            asum+                . fmap (\fmt -> parseTimeM True defaultTimeLocale fmt input)+                $ formats+        formats =+            [ "%Y-%m-%d %H:%M:%S"+            ]++gfnDateFormat :: Monad m => Function (Run m h)+gfnDateFormat args =+    let Right [gDate, gFormat, gTimeZone, gLocale] =+            extractArgsDefL+                [ ("date", def)+                , ("format", def)+                , ("tz", def)+                , ("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  gfnFilter :: Monad m => Function (Run m h) gfnFilter [] = return def