diff --git a/ginger.cabal b/ginger.cabal --- a/ginger.cabal +++ b/ginger.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: ginger -version: 0.2.1.0 +version: 0.2.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. @@ -24,6 +24,7 @@ , Text.Ginger.Html , Text.Ginger.Parse , Text.Ginger.Run + , Text.PrintfA -- other-modules: -- other-extensions: build-depends: base >=4.5 && <5 diff --git a/src/Text/Ginger/GVal.hs b/src/Text/Ginger/GVal.hs --- a/src/Text/Ginger/GVal.hs +++ b/src/Text/Ginger/GVal.hs @@ -47,6 +47,7 @@ import Data.Scientific ( Scientific , floatingOrInteger , toBoundedInteger + , toRealFloat ) import Control.Applicative import qualified Data.Aeson as JSON @@ -56,6 +57,7 @@ import Control.Monad ( forM, mapM ) import Control.Monad.Trans (MonadTrans, lift) import Data.Default (Default, def) +import Text.Printf import Text.Ginger.Html @@ -122,6 +124,18 @@ instance ToHtml (GVal m) where toHtml = asHtml +instance PrintfArg (GVal m) where + formatArg x fmt = + case fmtChar (vFmt 's' fmt) of + 's' -> formatString + (Text.unpack $ asText x) + (fmt { fmtChar = 's', fmtPrecision = Nothing }) + 'c' -> formatString + (Text.unpack $ asText x) + fmt + _ -> formatRealFloat + (toRealFloat . fromMaybe 0 . asNumber $ x :: Double) + fmt -- * Representing functions as 'GVal's -- diff --git a/src/Text/Ginger/Run.hs b/src/Text/Ginger/Run.hs --- a/src/Text/Ginger/Run.hs +++ b/src/Text/Ginger/Run.hs @@ -36,20 +36,21 @@ import Prelude ( (.), ($), (==), (/=) , (>), (<), (>=), (<=) - , (+), (-), (*), (/), div + , (+), (-), (*), (/), div, (**), (^) , (||), (&&) , (++) , Show, show , undefined, otherwise , Maybe (..) , Bool (..) - , Int - , fromIntegral, floor + , Int, Integer, String + , fromIntegral, floor, round , not , show , uncurry , seq - , snd + , fst, snd + , maybe ) import qualified Prelude import Data.Maybe (fromMaybe, isJust) @@ -57,6 +58,9 @@ import Text.Ginger.AST import Text.Ginger.Html import Text.Ginger.GVal +import Text.Printf +import Text.PrintfA +import Data.Scientific (formatScientific) import Data.Text (Text) import Data.String (fromString) @@ -73,8 +77,9 @@ import Data.Scientific (Scientific) import Data.Scientific as Scientific import Data.Default (def) -import Safe (readMay) +import Safe (readMay, lastDef) import Network.HTTP.Types (urlEncode) +import Debug.Trace (trace) -- | Execution context. Determines how to look up variables from the -- environment, and how to write out template output. @@ -149,7 +154,11 @@ , ("concat", fromFunction . variadicStringFunc $ mconcat) , ("contains", fromFunction gfnContains) , ("default", fromFunction gfnDefault) + , ("d", fromFunction gfnDefault) , ("difference", fromFunction . variadicNumericFunc 0 $ difference) + , ("escape", fromFunction gfnEscape) + , ("e", fromFunction gfnEscape) + , ("filesizeformat", fromFunction gfnFileSizeFormat) , ("equals", fromFunction gfnEquals) , ("nequals", fromFunction gfnNEquals) , ("greaterEquals", fromFunction gfnGreaterEquals) @@ -164,9 +173,11 @@ , ("modulo", fromFunction . variadicNumericFunc 1 $ fromIntegral . modulo . Prelude.map Prelude.floor) , ("num", fromFunction . unaryFunc $ toGVal . asNumber) , ("product", fromFunction . variadicNumericFunc 1 $ Prelude.product) + , ("printf", fromFunction gfnPrintf) , ("ratio", fromFunction . variadicNumericFunc 1 $ Scientific.fromFloatDigits . ratio . Prelude.map Scientific.toRealFloat) , ("round", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.round) , ("show", fromFunction . unaryFunc $ fromString . show) + , ("slice", fromFunction $ gfnSlice) , ("str", fromFunction . unaryFunc $ toGVal . asText) , ("sum", fromFunction . variadicNumericFunc 0 $ Prelude.sum) , ("truncate", fromFunction . unaryNumericFunc 0 $ Prelude.fromIntegral . Prelude.truncate) @@ -195,6 +206,9 @@ | asBoolean x = return x | otherwise = gfnDefault xs + gfnEscape :: Function (Run m h) + gfnEscape = return . toGVal . html . mconcat . fmap (asText . snd) + gfnAny :: Function (Run m h) gfnAny xs = return . toGVal $ Prelude.any (asBoolean . snd) xs @@ -299,6 +313,43 @@ gfnCenter ((_, s):(_, w):(_, pad):_) = return . toGVal $ center (asText s) (fromMaybe 80 $ Prelude.truncate <$> asNumber w) (asText pad) + gfnSlice :: Function (Run m h) + gfnSlice [] = return def + gfnSlice [(Nothing, slicee)] = return slicee + gfnSlice [(Nothing, slicee), (Nothing, startPos)] = + gfnSlice [(Nothing, slicee), (Nothing, startPos), (Nothing, def)] + gfnSlice [(Nothing, slicee), (Nothing, startPos), (Nothing, length)] = do + case asDictItems slicee of + Just items -> do + let slicedItems = slice items startInt lengthInt + return $ dict slicedItems + Nothing -> do + let items = fromMaybe [] $ asList slicee + slicedItems = slice items startInt lengthInt + return $ toGVal slicedItems + where + startInt :: Int + startInt = fromMaybe 0 . fmap Prelude.round . asNumber $ startPos + + lengthInt :: Maybe Int + lengthInt = fmap Prelude.round . asNumber $ length + + slice :: [a] -> Int -> Maybe Int -> [a] + slice xs start Nothing = + Prelude.drop start $ xs + slice xs start (Just length) = + Prelude.take length . Prelude.drop start $ xs + gfnSlice ((Nothing, slicee):(Nothing, startPos):args) = + let length = fromMaybe def $ List.lookup (Just "length") args + in gfnSlice [(Nothing, slicee), (Nothing, startPos), (Nothing, length)] + gfnSlice ((Nothing, slicee):args) = + let startPos = fromMaybe def $ List.lookup (Just "start") args + in gfnSlice ((Nothing, slicee):(Nothing, startPos):args) + gfnSlice args = + let slicee = fromMaybe def $ List.lookup (Just "slicee") args + in gfnSlice ((Nothing, slicee):args) + + gfnSort :: Function (Run m h) gfnSort [] = return def gfnSort ((_,sortee):args) = do @@ -351,6 +402,64 @@ paddingL = Text.take charsL . Text.replicate repsL $ pad repsR = Prelude.succ charsR `div` Text.length pad paddingR = Text.take charsR . Text.replicate repsR $ pad + + gfnFileSizeFormat :: Function (Run m h) + gfnFileSizeFormat [(_, sizeG)] = + gfnFileSizeFormat [(Nothing, sizeG), (Nothing, def)] + gfnFileSizeFormat [(_, sizeG), (_, binaryG)] = do + let sizeM = Prelude.round <$> asNumber sizeG + binary = asBoolean binaryG + Prelude.maybe + (return def) + (return . toGVal . formatFileSize binary) + sizeM + gfnFileSizeFormat _ = return def + + formatFileSize :: Bool -> Integer -> String + formatFileSize binary size = + let units = + if binary + then + [ (1, "B") + , (1024, "kiB") + , (1024 ^ 2, "MiB") + , (1024 ^ 3, "GiB") + , (1024 ^ 4, "TiB") + , (1024 ^ 5, "PiB") + ] + else + [ (1, "B") + , (1000, "kB") + , (1000000, "MB") + , (1000000000, "GB") + , (1000000000000, "TB") + , (1000000000000000, "PB") + ] + (divisor, unitName) = + lastDef (1, "B") [ (d, u) | (d, u) <- units, d <= size ] + dividedSize :: Scientific + dividedSize = fromIntegral size / fromIntegral divisor + formattedSize = + if isInteger dividedSize + then formatScientific Fixed (Just 0) dividedSize + else formatScientific Fixed (Just 1) dividedSize + in formattedSize ++ " " ++ unitName + + gfnPrintf :: Function (Run m h) + gfnPrintf [] = return def + gfnPrintf [(_, fmtStrG)] = return fmtStrG + gfnPrintf ((_, fmtStrG):args) = do + return . toGVal $ printfG fmtStr (fmap snd args) + where + fmtStr = Text.unpack $ asText fmtStrG + +printfG :: String -> [GVal m] -> String +printfG fmt args = printfa fmt (fmap (P . asText) args) + +apply :: (a -> b -> b) -> b -> [a] -> b +apply f z [] = z +apply f z [x] = f x z +apply f z (x:xs) = f x (apply f z xs) -- | Create an execution context for runGingerT. -- Takes a lookup function, which returns ginger values into the carrier monad diff --git a/src/Text/PrintfA.hs b/src/Text/PrintfA.hs new file mode 100644 --- /dev/null +++ b/src/Text/PrintfA.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RankNTypes #-} +module Text.PrintfA +where + +import Text.Printf + +data PrintfArgT = forall a. PrintfArg a => P a +data PrintfTypeT = T { unT :: forall r. PrintfType r => r } + +printfa :: PrintfType t => String -> [ PrintfArgT ] -> t +printfa format = unT . foldl (\(T r) (P a) -> T $ r a ) (T $ printf format)