HStringTemplate 0.5.1.3 → 0.6

raw patch · 6 files changed

+115/−39 lines, 6 filesdep +textdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: text

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• HStringTemplate.cabal +3/−3
• Text/StringTemplate/Base.hs +33/−23
• Text/StringTemplate/Classes.hs +40/−9
• Text/StringTemplate/GenericStandard.hs +22/−0
• Text/StringTemplate/Group.hs +6/−4
• Text/StringTemplate/Instances.hs +11/−0

@@ -1,5 +1,5 @@ name:                HStringTemplate-version:             0.5.1.3+version:             0.6 synopsis:            StringTemplate implementation in Haskell. description:         A port of the Java library by Terrence Parr. category:            Text@@ -25,9 +25,9 @@     exposed-modules: Text.StringTemplate.QQ    if flag(smaller-base)-    build-depends:   syb, base >= 4, base < 5, filepath, parsec < 3, containers, pretty, time, old-time, old-locale, bytestring, directory, array+    build-depends:   syb, base >= 4, base < 5, filepath, parsec < 3, containers, pretty, time, old-time, old-locale, bytestring, directory, array, text   else-    build-depends:   base > 3, base < 4, filepath, parsec < 3, containers, pretty, time, old-time, old-locale, bytestring, directory, array+    build-depends:   base > 3, base < 4, filepath, parsec < 3, containers, pretty, time, old-time, old-locale, bytestring, directory, array, text   exposed-modules:   Text.StringTemplate                      Text.StringTemplate.Base                      Text.StringTemplate.Classes

@@ -120,7 +120,6 @@ setManyNativeAttrib :: (Stringable b) => [(String, b)] -> StringTemplate b -> StringTemplate b setManyNativeAttrib = flip . foldl' . flip $ uncurry setNativeAttribute - -- | Replaces the attributes of a StringTemplate with those -- described in the second argument. If the argument does not yield -- a set of named attributes but only a single one, that attribute@@ -147,7 +146,7 @@  -- | Sets an encoding function of a template that all values are -- rendered with. For example one useful encoder would be 'Text.Html.stringToHtmlString'. All attributes will be encoded once and only once.-setEncoder :: (Stringable a) => (String -> String) -> StringTemplate a -> StringTemplate a+setEncoder :: (Stringable a) => (a -> a) -> StringTemplate a -> StringTemplate a setEncoder x st = st {senv = (senv st) {senc = x} }  -- | A special template that simply dumps the values of all the attributes set in it.@@ -161,7 +160,7 @@ --------------------------------------------------------------------} --IMPLEMENT groups having stLookup return a Maybe for regions -data SEnv a = SEnv {smp :: SMap a, sopts :: [(String, (SEnv a -> SElem a))], sgen :: STGroup a, senc :: String -> String}+data SEnv a = SEnv {smp :: SMap a, sopts :: [(String, (SEnv a -> SElem a))], sgen :: STGroup a, senc :: a -> a}  inSGen :: (STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a inSGen f st@STMP{senv = env} = st {senv = env {sgen = f (sgen env)} }@@ -210,23 +209,26 @@   Internal API for polymorphic display of elements --------------------------------------------------------------------} +mconcatMap' :: Stringable a => SEnv a -> [b] -> (b -> a) -> a+mconcatMap' snv xs f = mintercalate sep . map f $ xs+    where sep = showVal snv $ fromMaybe (justSTR "") =<< optLookup "separator" $ snv+ showVal :: Stringable a => SEnv a -> SElem a -> a showVal snv se = case se of                    STR x  -> stEncode x-                   BS  x  -> stFromByteString x+                   BS  x  -> stEncodeBS x                    LI xs  -> joinUpWith showVal xs                    SM sm  -> joinUpWith showAssoc $ M.assocs sm                    STSH x -> stEncode (format x)-                   SBLE x -> x+                   SBLE x -> senc snv x                    SNull  -> showVal <*> nullOpt $ snv-    where sepVal = fromMaybe (justSTR "") =<< optLookup "separator" $ snv-          format = maybe stshow . stfshow <*> optLookup "format" $ snv-          joinUpWith f = mintercalate (showVal snv sepVal) . map (f snv)+    where format = maybe stshow . stfshow <*> optLookup "format" $ snv+          joinUpWith f xs = mconcatMap' snv xs (f snv)           showAssoc e (k,v) = stEncode (k ++ ": ") `mlabel` showVal e v-          stEncode = stFromString . senc snv+          stEncode   = senc snv . stFromString+          stEncodeBS = senc snv . stFromByteString  showStr :: Stringable a => String -> SEnv a -> a---showStr = flip showVal . STR showStr = const . stFromString  {--------------------------------------------------------------------@@ -262,13 +264,15 @@ {--------------------------------------------------------------------   The Grammar --------------------------------------------------------------------}+myConcat :: Stringable a => [SEnv a -> a] -> (SEnv a -> a)+myConcat xs a = smconcat $ map ($ a) xs  -- | if p is true, stmpl can fail gracefully, false it dies hard. -- Set to false at the top level, and true within if expressions. stmpl :: Stringable a => Bool -> TmplParser (SEnv a -> a) stmpl p = do   (ca, cb) <- getSeps-  mconcat <$> many (showStr <$> escapedStr [ca] <|> try (around ca optExpr cb)+  myConcat <$> many (showStr <$> escapedStr [ca] <|> try (around ca optExpr cb)                     <|> try comment <|> bl <?> "template")       where bl | p = try blank | otherwise = blank @@ -276,7 +280,7 @@ subStmp = do   (ca, cb) <- getSeps   udEnv <- option (transform ["it"]) (transform <$> try attribNames)-  st <- mconcat <$> many (showStr <$> escapedStr (ca:"}|")+  st <- myConcat <$> many (showStr <$> escapedStr (ca:"}|")                          <|> try (around ca optExpr cb)                          <|> try comment <|> blank  <?> "subtemplate")   return (st <$$> udEnv)@@ -304,15 +308,21 @@   (try (string ("else"++[cb])) <|> try (string "elseif(") <|>     try (string "endif")) .>> fail "Malformed If Statement." <|> return ()   expr <- try ifstat <|> spaced exprn-  opts <- many opt-  skipMany (char ';')+  opts <- (char ';' >> optList) <|> return []   return $ expr . optInsert opts-      where opt = around ';' (spaced word) '=' >>= (<$> spaced subexprn) . (,)+      where -- opt = around ';' (spaced word) '=' >>= (<$> spaced subexprn) . (,)+            optList = sepBy oneOpt (char ',' <|> char ';')+            oneOpt = do+              o <- spaced word+              char '='+              v <- spaced subexprn+              return (o,v)  {--------------------------------------------------------------------   Statements --------------------------------------------------------------------} +--if env then do stuff getProp :: Stringable a => [SEnv a -> SElem a] -> SElem a -> SEnv a -> SElem a getProp (p:ps) (SM mp) env =   case M.lookup (stToString . showVal env $ p env) mp of@@ -412,7 +422,7 @@   (fApply f .) <$> around '(' subexprn ')'       where fApply str (LI xs)                 | str == "first"  = if null xs then SNull else head xs-                | str == "last"   = last xs+                | str == "last"   = if null xs then SNull else last xs                 | str == "rest"   = if null xs then SNull else (LI . tail) xs                 | str == "strip"  = LI . filter (not . liNil) $ xs                 | str == "length" = STR . show . length $ xs@@ -434,7 +444,7 @@ ix0 = [STR "1",STR "0"]  cycleApp :: (Stringable a) => [([SElem a], [SElem a]) -> SEnv a -> a] -> [([SElem a], [SElem a])]  -> SEnv a -> a-cycleApp x y = mconcatMap (zipWith ($) (cycle x) y) . flip ($)+cycleApp x y snv = mconcatMap' snv (zipWith ($) (cycle x) y) ($ snv)  pluslen :: [a] -> [([a], [SElem b])] pluslen xs = zip (map (:[]) xs) $ mkIndex [0..(length xs)]@@ -445,12 +455,12 @@           pluslen' xs = zip xs $ mkIndex [0..(length xs)]  iterApp :: Stringable a => [([SElem a], [SElem a]) -> SEnv a -> a] -> [SElem a] -> SEnv a -> a-iterApp [f] (LI xs:[])    = (mconcatMap $ pluslen xs) . flip f-iterApp [f] vars@(LI _:_) = (mconcatMap $ liTrans vars) . flip f-iterApp [f] v             = f (v,ix0)-iterApp fs (LI xs:[])     = cycleApp fs (pluslen xs)-iterApp fs vars@(LI _:_)  = cycleApp fs (liTrans vars)-iterApp fs xs             = cycleApp fs (pluslen xs)+iterApp [f] (LI xs:[])    snv = (mconcatMap' snv $ pluslen xs) . flip f $ snv+iterApp [f] vars@(LI _:_) snv = (mconcatMap' snv $ liTrans vars) . flip f $ snv+iterApp [f] v             snv = f (v,ix0) snv+iterApp fs (LI xs:[])     snv = cycleApp fs (pluslen xs) snv+iterApp fs vars@(LI _:_)  snv = cycleApp fs (liTrans vars) snv+iterApp fs xs             snv = cycleApp fs (pluslen xs) snv  anonTmpl :: Stringable a => TmplParser (([SElem a], [SElem a]) -> SEnv a -> a) anonTmpl = around '{' subStmp '}'

@@ -9,6 +9,10 @@ import Data.Monoid import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT import qualified Text.PrettyPrint.HughesPJ as PP  newtype StFirst a = StFirst { stGetFirst :: Maybe a }@@ -57,24 +61,33 @@  -- | The Stringable class should be instantiated with care. -- Generally, the provided instances should be enough for anything.-class Monoid a => Stringable a where+class Stringable a where     stFromString :: String -> a     stFromByteString :: LB.ByteString -> a     stFromByteString = stFromString . LB.unpack     stToString :: a -> String     -- | Defaults to  @ mconcatMap m k = foldr (mappend . k) mempty m @     mconcatMap :: [b] -> (b -> a) -> a-    mconcatMap m k = foldr (mappend . k) mempty m+    mconcatMap m k = foldr (smappend . k) smempty m     -- | Defaults to  @ (mconcat .) . intersperse @     mintercalate :: a -> [a] -> a-    mintercalate = (mconcat .) . intersperse-    -- | Defaults to  @  mlabel x y = mconcat [x, stFromString "[", y, stFromString "]"] @+    mintercalate = (smconcat .) . intersperse+    -- | Defaults to  @  mlabel x y = smconcat [x, stFromString "[", y, stFromString "]"] @     mlabel :: a -> a -> a-    mlabel x y = mconcat [x, stFromString "[", y, stFromString "]"]+    mlabel x y = smconcat [x, stFromString "[", y, stFromString "]"]+    -- | Just mempty. Here to avoid orphan instances+    smempty :: a+    -- | Just mappend. Here to avoid orphan instances+    smappend :: a -> a -> a+    -- | Just mconcat. Here to avoid orphan instances+    smconcat :: [a] -> a+    smconcat xs = foldr (smappend . id) smempty xs  instance Stringable String where     stFromString = id     stToString = id+    smempty = ""+    smappend = (++)  instance Stringable PP.Doc where     stFromString = PP.text@@ -82,21 +95,39 @@     mconcatMap m k = PP.fcat . map k $ m     mintercalate = (PP.fcat .) . PP.punctuate     mlabel x y = x PP.$$ PP.nest 1 y--instance Monoid PP.Doc where-    mempty = PP.empty-    x `mappend` y = x PP.<> y+    smempty = PP.empty+    smappend = (PP.<>)  instance Stringable B.ByteString where     stFromString = B.pack     stFromByteString = B.concat . LB.toChunks     stToString = B.unpack+    smempty = B.empty+    smappend = B.append  instance Stringable LB.ByteString where     stFromString = LB.pack     stFromByteString = id     stToString = LB.unpack+    smempty = LB.empty+    smappend = LB.append +instance Stringable T.Text where+    stFromString = T.pack+    stFromByteString = T.decodeUtf8 . B.concat . LB.toChunks+    stToString = T.unpack+    smempty = T.empty+    smappend = T.append++instance Stringable LT.Text where+    stFromString = LT.pack+    stFromByteString = LT.decodeUtf8+    stToString = LT.unpack+    smempty = LT.empty+    smappend = LT.append+ instance Stringable (Endo String) where     stFromString = Endo . (++)     stToString = ($ []) . appEndo+    smempty = mempty+    smappend = mappend

@@ -10,6 +10,15 @@ import Text.StringTemplate.Instances() import Data.Generics.Basics import Data.Generics.Aliases+import qualified Data.Map as M+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.Maybe+-- import qualified System.Time as OldTime+-- import System.Locale+-- import Data.Time+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT  gToSElem :: forall a b.(Data a, Stringable b) => a -> SElem b gToSElem = (\x ->@@ -21,12 +30,25 @@            `ext1Q` (\t -> case t of (Just x) -> gToSElem x; _ -> SNull)            `ext1Q` (SM . fmap gToSElem)            `ext1Q` (LI . map gToSElem)+           -- `extQ` (toSElem :: OldTime.CalendarTime -> SElem b)+           -- `extQ` (toSElem :: OldTime.TimeDiff -> SElem b)+           -- `extQ` (toSElem :: TimeOfDay -> SElem b)+           -- `extQ` (toSElem :: UTCTime -> SElem b)+           -- `extQ` (toSElem :: TimeZone -> SElem b)+           -- `extQ` (toSElem :: ZonedTime -> SElem b)+           -- `extQ` (toSElem :: Day -> SElem b)+           -- `extQ` (toSElem :: LocalTime -> SElem b)+           `extQ` (toSElem :: LB.ByteString -> SElem b)+           `extQ` (toSElem :: B.ByteString -> SElem b)+           `extQ` (toSElem :: LT.Text -> SElem b)+           `extQ` (toSElem :: T.Text -> SElem b)            `extQ` (toSElem :: Bool -> SElem b)            `extQ` (toSElem :: Float -> SElem b)            `extQ` (toSElem :: Double -> SElem b)            `extQ` (toSElem :: Int -> SElem b)            `extQ` (toSElem :: Integer -> SElem b)            `extQ` (toSElem :: String -> SElem b)+  instance Data a => ToSElem a     where toSElem = gToSElem

@@ -42,10 +42,12 @@  getTmplsRecursive :: FilePath -> FilePath -> IO [(FilePath, FilePath)] getTmplsRecursive base fp = do-          dirContents <- getDirectoryContents fp-          subDirs <- filterM doesDirectoryExist =<< getDirectoryContents fp+          dirContents <- filter (not . isPrefixOf ".") <$> getDirectoryContents fp+          subDirs <- filterM (doesDirectoryExist . (fp </>)) dirContents           subs <- concat <$> mapM (\x -> getTmplsRecursive (base </> x) (fp </> x)) subDirs-          return $ (map ((</>) fp &&& (</>) base) $ filter ((".st" ==) . takeExtension) dirContents) ++ subs+          return $ (map ((fp </>) &&& (\x -> base </> dropExtension x)) $+                    filter ((".st" ==) . takeExtension) dirContents)+                   ++ subs  {--------------------------------------------------------------------   Group API@@ -111,7 +113,7 @@  -- | Sets an encoding function of a group that all values are -- rendered with in each enclosed template-setEncoderGroup :: (Stringable a) => (String -> String) ->  STGroup a -> STGroup a+setEncoderGroup :: (Stringable a) => (a -> a) ->  STGroup a -> STGroup a setEncoderGroup x f = (inSGen (setEncoderGroup x) . setEncoder x) <$$> f  -- | For any requested template, returns a message that the template was

@@ -16,7 +16,12 @@ import qualified System.Time as OldTime import System.Locale import Data.Time+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT + {--------------------------------------------------------------------   Additional instances for items that may be set as StringTemplate   attributes. The code should provide examples of how to proceed.@@ -32,6 +37,12 @@  instance ToSElem B.ByteString where     toSElem = BS . LB.fromChunks . (:[])++instance ToSElem LT.Text where+    toSElem = BS . LT.encodeUtf8++instance ToSElem T.Text where+    toSElem = BS . LB.fromChunks . (:[]) . T.encodeUtf8  instance ToSElem Bool where     toSElem True = STR ""