HStringTemplate 0.5.1.2 → 0.5.1.3

raw patch · 8 files changed

+77/−36 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• HStringTemplate.cabal +10/−5
• Text/StringTemplate/Base.hs +14/−14
• Text/StringTemplate/Classes.hs +4/−4
• Text/StringTemplate/GenericStandard.hs +36/−0
• Text/StringTemplate/GenericWithClass.hs +3/−3
• Text/StringTemplate/Group.hs +6/−6
• Text/StringTemplate/QQ.hs +3/−3
• Text/StringTemplate/Renderf.hs +1/−1

@@ -1,5 +1,5 @@ name:                HStringTemplate-version:             0.5.1.2+version:             0.5.1.3 synopsis:            StringTemplate implementation in Haskell. description:         A port of the Java library by Terrence Parr. category:            Text@@ -7,21 +7,19 @@ license-file:        LICENSE author:              Sterling Clover maintainer:          s.clover@gmail.com-Tested-With:         GHC == 6.8.2+Tested-With:         GHC == 6.10.3 Build-Type:          Simple build-Depends:       base-Cabal-Version:       >= 1.2+Cabal-Version:       >= 1.6  flag smaller-base flag syb-with-class-flag simple-generics flag quasi-quotation  library   if flag(syb-with-class)     build-depends:   syb-with-class     exposed-modules: Text.StringTemplate.GenericWithClass-   if flag(quasi-quotation)     build-depends: template-haskell >= 2.3, mtl     exposed-modules: Text.StringTemplate.QQ@@ -33,7 +31,14 @@   exposed-modules:   Text.StringTemplate                      Text.StringTemplate.Base                      Text.StringTemplate.Classes+                     Text.StringTemplate.GenericStandard   other-modules:     Text.StringTemplate.Instances                      Text.StringTemplate.Group                      Text.StringTemplate.Renderf   ghc-options:       -Wall+  if impl(ghc >= 6.8)+    ghc-options:     -fwarn-tabs++source-repository head+  type:     darcs+  location: http://code.haskell.org/HStringTemplate/

@@ -28,14 +28,14 @@   Generic Utilities --------------------------------------------------------------------} -type TmplParser x = GenParser Char ((Char, Char),[String]) x+type TmplParser = GenParser Char ((Char, Char),[String])  (<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)-(<$$>) x y = ((<$>) . (<$>)) x y+(<$$>) = (<$>) . (<$>) infixr 8 <$$>  (|.) :: (t1 -> t2) -> (t -> t1) -> t -> t2-(|.) f g x = f (g x)+(|.) f g = f . g infixr 3 |.  (.>>) :: (Monad m) => m a -> m b -> m b@@ -52,11 +52,11 @@ paddedTrans :: a -> [[a]] -> [[a]] paddedTrans _ [] = [] paddedTrans n as = take (maximum . map length $ as) . trans $ as-    where trans ([] : xss)  = (n : map h xss) :  trans ([n] : (map t xss))-          trans ((x : xs) : xss) = (x : map h xss) : trans (m xs : (map t xss))+    where trans ([] : xss)  = (n : map h xss) :  trans ([n] : map t xss)+          trans ((x : xs) : xss) = (x : map h xss) : trans (m xs : map t xss)           trans _ = [];-          h (x:_) = x; h _ = n; t (_:y:xs) = (y:xs); t _ = [n];-          m (x:xs) = (x:xs); m _ = [n];+          h (x:_) = x; h _ = n; t (_:y:xs) = y:xs; t _ = [n];+          m (x:xs) = x:xs; m _ = [n];  {--------------------------------------------------------------------   StringTemplate and the API@@ -182,7 +182,7 @@ nullOpt :: SEnv a -> SElem a nullOpt = fromMaybe (justSTR "") =<< optLookup "null" -stLookup :: (Stringable a) => [Char] -> SEnv a -> StringTemplate a+stLookup :: (Stringable a) => String -> SEnv a -> StringTemplate a stLookup x env = maybe (newSTMP ("No Template Found for: " ++ x))                  (\st-> st {senv = mergeSEnvs env (senv st)}) $ stGetFirst (sgen env x) @@ -192,7 +192,7 @@ mergeSEnvs x y = SEnv {smp = M.union (smp x) (smp y), sopts = (sopts y ++ sopts x), sgen = sgen x, senc = senc y}  parseSTMP :: (Stringable a) => (Char, Char) -> String -> SEnv a -> a-parseSTMP x = either (showStr .  show) (id) . runParser (stmpl False) (x,[]) ""+parseSTMP x = either (showStr .  show) id . runParser (stmpl False) (x,[]) ""  getSeps :: TmplParser (Char, Char) getSeps = fst <$> getState@@ -227,7 +227,7 @@  showStr :: Stringable a => String -> SEnv a -> a --showStr = flip showVal . STR-showStr s = const (stFromString $ s)+showStr = const . stFromString  {--------------------------------------------------------------------   Utility Combinators@@ -245,7 +245,7 @@ around x p y = do {char x; v<-p; char y; return v} spaced :: GenParser Char st t -> GenParser Char st t spaced p = do {spaces; v<-p; spaces; return v}-word :: GenParser Char st [Char]+word :: GenParser Char st String word = many1 alphaNum comlist :: GenParser Char st a -> GenParser Char st [a] comlist p = spaced (p `sepBy1` spaced (char ','))@@ -253,7 +253,7 @@ props :: Stringable a => TmplParser [SEnv a -> SElem a] props = many $ char '.' >> (around '(' subexprn ')' <|> justSTR <$> word) -escapedChar, escapedStr :: [Char] -> GenParser Char st [Char]+escapedChar, escapedStr :: String -> GenParser Char st String escapedChar chs =     noneOf chs >>= \x -> if x == '\\' then anyChar >>= \y ->     if y `elem` chs then return [y] else return [x, y] else return [x]@@ -287,7 +287,7 @@ comment :: Stringable a => TmplParser (SEnv a -> a) comment = do   (ca, cb) <- getSeps-  string (ca:'!':[]) >> manyTill anyChar (try . string $ '!':cb:[])+  string [ca,'!'] >> manyTill anyChar (try . string $ ['!',cb])   return (showStr "")  blank :: Stringable a => TmplParser (SEnv a -> a)@@ -417,7 +417,7 @@                 | str == "strip"  = LI . filter (not . liNil) $ xs                 | str == "length" = STR . show . length $ xs             fApply str x-                | str == "rest"   = (LI [])+                | str == "rest"   = LI []                 | str == "length" = STR "1"                 | otherwise       = x             liNil (LI x) = null x

@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, StandaloneDeriving, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeSynonymInstances #-} {-# OPTIONS_HADDOCK not-home #-} module Text.StringTemplate.Classes     (SElem(..), StringTemplateShows(..), ToSElem(..), SMap, STShow(..),@@ -19,7 +19,7 @@         StFirst Nothing `mappend` r = r  instance Functor StFirst where-    fmap f x = StFirst . fmap f . stGetFirst $ x+    fmap f = StFirst . fmap f . stGetFirst  type SMap a = M.Map String (SElem a) @@ -72,7 +72,7 @@     mlabel :: a -> a -> a     mlabel x y = mconcat [x, stFromString "[", y, stFromString "]"] -instance Stringable [Char] where+instance Stringable String where     stFromString = id     stToString = id @@ -81,7 +81,7 @@     stToString = PP.render     mconcatMap m k = PP.fcat . map k $ m     mintercalate = (PP.fcat .) . PP.punctuate-    mlabel x y = (x PP.$$ PP.nest 1 y)+    mlabel x y = x PP.$$ PP.nest 1 y  instance Monoid PP.Doc where     mempty = PP.empty

@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances, Rank2Types, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+--------------------------------------------------------------------+-- | Generic Instance for ToSElem using standard Data.Generic libraries.+--------------------------------------------------------------------}++module Text.StringTemplate.GenericStandard() where+import qualified Data.Map as M+import Text.StringTemplate.Classes+import Text.StringTemplate.Instances()+import Data.Generics.Basics+import Data.Generics.Aliases++gToSElem :: forall a b.(Data a, Stringable b) => a -> SElem b+gToSElem = (\x ->+            case (map stripInitUnder (constrFields . toConstr $ x)) of+              [] -> LI (STR (showConstr (toConstr x)) :+                        gmapQ gToSElem x)+              fs -> SM (M.fromList (zip fs (gmapQ gToSElem x)))+           )+           `ext1Q` (\t -> case t of (Just x) -> gToSElem x; _ -> SNull)+           `ext1Q` (SM . fmap gToSElem)+           `ext1Q` (LI . map gToSElem)+           `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++stripInitUnder :: String -> String+stripInitUnder ('_':s) = stripInitUnder s+stripInitUnder s       = s

@@ -10,7 +10,7 @@ import Text.StringTemplate.Classes import Data.Generics.SYB.WithClass.Basics -stripInitialUnderscores :: [Char] -> [Char]+stripInitialUnderscores :: String -> String stripInitialUnderscores ('_':s) = stripInitialUnderscores s stripInitialUnderscores s       = s @@ -27,14 +27,14 @@        | isAlgType (dataTypeOf toSElemProxy x) =            case (map stripInitialUnderscores (getFields x)) of              [] -> LI (STR (showConstr (toConstr toSElemProxy x)) :-                           (gmapQ toSElemProxy (toSElemD dict) x))+                           gmapQ toSElemProxy (toSElemD dict) x)              fs -> SM (M.fromList (zip fs (gmapQ toSElemProxy (toSElemD dict) x)))        | True =                error ("Unable to serialize the primitive type '" ++                       dataTypeName (dataTypeOf toSElemProxy x) ++ "'")  getFields :: Data ToSElemD a => a -> [String]-getFields = constrFields . (toConstr toSElemProxy)+getFields = constrFields . toConstr toSElemProxy  instance Data ToSElemD t => ToSElem t where    toSElem = genericToSElem

@@ -28,7 +28,7 @@ --------------------------------------------------------------------}  (<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)-(<$$>) x y = ((<$>) . (<$>)) x y+(<$$>) = (<$>) . (<$>)  readFile' :: FilePath -> IO String readFile' f = do@@ -38,14 +38,14 @@ groupFromFiles :: Stringable a => (FilePath -> IO String) -> [(FilePath,String)] -> IO (STGroup a) groupFromFiles rf fs = groupStringTemplates <$> forM fs  (\(f,fname) -> do      stmp <- newSTMP <$> rf f-     return $ (fname, stmp))+     return (fname, stmp))  getTmplsRecursive :: FilePath -> FilePath -> IO [(FilePath, FilePath)] getTmplsRecursive base fp = do           dirContents <- getDirectoryContents fp           subDirs <- filterM doesDirectoryExist =<< getDirectoryContents fp           subs <- concat <$> mapM (\x -> getTmplsRecursive (base </> x) (fp </> x)) subDirs-          return $ (map (\x -> (fp </> x, base </> x)) $ filter ((".st" ==) . takeExtension) dirContents) ++ subs+          return $ (map ((</>) fp &&& (</>) base) $ filter ((".st" ==) . takeExtension) dirContents) ++ subs  {--------------------------------------------------------------------   Group API@@ -65,7 +65,7 @@ directoryGroup :: (Stringable a) => FilePath -> IO (STGroup a) directoryGroup path =     groupFromFiles readFile' .-    map (\x -> (path </> x, takeBaseName x)) . filter ((".st" ==) . takeExtension) =<<+    map ((</>) path &&& takeBaseName) . filter ((".st" ==) . takeExtension) =<<     getDirectoryContents path  -- | Given a path, returns a group which generates all files in said directory@@ -78,7 +78,7 @@ directoryGroupLazy :: (Stringable a) => FilePath -> IO (STGroup a) directoryGroupLazy path =     groupFromFiles readFile .-    map (\x -> (path </> x, takeBaseName x)) . filter ((".st" ==) . takeExtension) =<<+    map ((</>) path &&& takeBaseName) . filter ((".st" ==) . takeExtension) =<<     getDirectoryContents path  -- | As with 'directoryGroup', but traverses subdirectories as well. A template named@@ -118,7 +118,7 @@ -- unable to be found. Useful to add as a super group for a set of templates -- under development, to aid in debugging. nullGroup :: Stringable a => STGroup a-nullGroup = \x -> StFirst . Just . newSTMP $ "Could not find template: " ++ x+nullGroup x = StFirst . Just . newSTMP $ "Could not find template: " ++ x  -- | Given an integral amount of seconds and a path, returns a group generating -- all files in said directory and subdirectories with the proper \"st\" extension,

@@ -33,10 +33,10 @@     vars = case parseSTMPNames s of              Right xs -> xs              Left  err -> error $ show err-    base  = TH.AppE (TH.VarE (TH.mkName "newSTMP")) (TH.LitE (TH.StringL $ s))+    base  = TH.AppE (TH.VarE (TH.mkName "newSTMP")) (TH.LitE (TH.StringL s))     tmpl  = foldr addAttrib base vars-    addAttrib var x = TH.AppE+    addAttrib var = TH.AppE         (TH.AppE (TH.AppE (TH.VarE (TH.mkName "setAttribute"))                           (TH.LitE (TH.StringL ('`' : var ++ "`"))))                  (TH.VarE (TH.mkName  var)))-        x+

@@ -9,7 +9,7 @@ instance Stringable a => SEType a (StringTemplate a) where     renderf = id instance (ToSElem a, SEType b r) => SEType b ((String, a) -> r) where-    renderf x = \(k,v) -> renderf $ setAttribute k v x+    renderf x (k, v) = renderf $ setAttribute k v x  (|=) :: (Monad m) => a -> m a1 -> m (a, a1) k |= v = return . (,) k =<< v