HStringTemplate 0.8.7 → 0.8.8

raw patch · 5 files changed

+210/−14 lines, 5 filesdep +HStringTemplatedep +HUnitdep +QuickCheckdep ~arraydep ~basedep ~blaze-builderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HStringTemplate, HUnit, QuickCheck, random

Dependency ranges changed: array, base, blaze-builder, bytestring, containers, deepseq, directory, filepath, mtl, old-locale, parsec, pretty, semigroups, syb, template-haskell, text, time, void

API changes (from Hackage documentation)

Files

• HStringTemplate.cabal +36/−10
• Text/StringTemplate/Group.hs +4/−4
• tests/Main.hs +8/−0
• tests/Properties.hs +120/−0
• tests/Units.hs +42/−0

@@ -1,5 +1,6 @@+Cabal-Version:       1.18 name:                HStringTemplate-version:             0.8.7+version:             0.8.8 synopsis:            StringTemplate implementation in Haskell. description:         A port of the Java library by Terrence Parr. category:            Text@@ -7,17 +8,37 @@ license-file:        LICENSE author:              Sterling Clover maintainer:          s.clover@gmail.com-Tested-With:         GHC == 8.2+Tested-With:         GHC == 8.2, GHC == 9.0.1 Build-Type:          Simple-Cabal-Version:       >= 1.6  -library -  build-depends:   syb, base >= 4, base < 5, filepath, parsec < 4, containers, pretty >= 1.1.0.0,-                   time >= 1.4.2 && < 1.9, bytestring, directory, array, text, deepseq, blaze-builder,void, template-haskell >= 2.3, mtl,-                   old-locale, semigroups >= 0.16+source-repository head+  type:     darcs+  location: http://hub.darcs.net/sterlingclover/hstringtemplate +library+  default-language: Haskell2010+  build-depends:+    base             >= 4 && < 5,+    array            < 0.6,+    blaze-builder    < 0.5,+    bytestring       < 0.11,+    deepseq          < 1.5,+    text             < 1.3,+    containers       < 0.7,+    template-haskell >= 2.3 && < 2.18,+    pretty           < 1.2,+    directory        < 1.4,+    filepath         < 1.5,+    mtl              < 2.3,+    old-locale       < 1.1,+    parsec           > 3 && < 4,+    semigroups       >= 0.16 && < 0.20,+    syb              < 0.8,+    void             < 0.8,+    time >= 1.4.2 && < 1.10+   exposed-modules:   Text.StringTemplate                      Text.StringTemplate.Base                      Text.StringTemplate.Classes@@ -28,6 +49,11 @@                      Text.StringTemplate.Renderf   ghc-options:       -Wall -source-repository head-  type:     darcs-  location: http://hub.darcs.net/sterlingclover/hstringtemplate+test-suite test+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  main-is:          Main.hs+  hs-source-dirs:   tests+  build-depends:    HStringTemplate, base, containers, QuickCheck >= 2.13, random >= 1.0 , HUnit >= 1.5+  other-modules:    Properties+                    Units

@@ -40,8 +40,8 @@    hSetEncoding h utf8    hGetContents h -readFile' :: FilePath -> IO String-readFile' f = do+readFileStrictly :: FilePath -> IO String+readFileStrictly f = do    x <- readFileUTF f    length x `seq` return x @@ -80,7 +80,7 @@ -- | Given a path, returns a group which generates all files in said directory which have the supplied extension. directoryGroupExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a) directoryGroupExt ext path =-    groupFromFiles readFile' .+    groupFromFiles readFileStrictly .     map ((</>) path &&& takeBaseName) . filter ((ext ==) . takeExtension) =<<     getDirectoryContents path @@ -108,7 +108,7 @@  -- | As with 'directoryGroupRecursive', but a template extension is supplied. directoryGroupRecursiveExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)-directoryGroupRecursiveExt ext path = groupFromFiles readFile' =<< getTmplsRecursive ext "" path+directoryGroupRecursiveExt ext path = groupFromFiles readFileStrictly =<< getTmplsRecursive ext "" path  -- | See documentation for 'directoryGroupRecursive'. directoryGroupRecursiveLazy :: (Stringable a) => FilePath -> IO (STGroup a)

@@ -0,0 +1,8 @@+module Main where++import qualified Properties+import qualified Units++main = do+  Properties.main+  Units.main

@@ -0,0 +1,120 @@+{-# OPTIONS -O2 -fglasgow-exts #-}++module Properties where+import Text.Printf+import Control.Monad+import Control.Arrow+import Control.Applicative hiding ((<|>),many)+import Data.Maybe+import Data.Monoid+import Data.List+import System.IO+import System.Random hiding (next)+import qualified Data.Map as M++import Text.StringTemplate+import Text.StringTemplate.Classes+import Text.StringTemplate.Base+import Test.QuickCheck+import System.Environment+++main :: IO ()+main = do+    args <- getArgs+    let n = if null args then 100 else read (head args)+    results <- mapM (\ (s, a) -> printf "%-25s: " s >> fmap (\x->(s,x)) a) tests+    mapM print results+    when (not $ all (isSuccess  . snd) results) $ fail "Not all tests passed!"+ where+    isSuccess (Success _ _ _ _ _ _) = True+    isSuccess _ = False+    tests =+        [("prop_paddedTrans" , mytest prop_paddedTrans),+         ("prop_constStr" , mytest prop_constStr),+         ("prop_emptyNulls" , mytest prop_emptyNulls),+         ("prop_fullNulls" , mytest prop_fullNulls),+         ("prop_substitution" , mytest prop_substitution),+         ("prop_separator" , mytest prop_separator),+         ("prop_attribs" , mytest prop_attribs),+         ("prop_comment" , mytest prop_comment),+         ("prop_ifelse" , mytest prop_ifelse),+         ("prop_simpleGroup" , mytest prop_simpleGroup)+        ]+mytest x = quickCheckResult x+{-----------------------------------------------------------------------+  Limited tests for now: just for list juggling and some basic parsing.+-----------------------------------------------------------------------}++prop_paddedTrans (x::[Int]) (y::[Int]) (z::[Int]) n =+   (length pt == length npt) &&+   all (3 ==) (map length pt) &&+   all (all (==n)) (zipWith unmerge (paddedTrans n pt) [x,y,z])+          where pt   = paddedTrans n [x,y,z]+                npt  = transpose [x,y,z]+                unmerge xl@(x:xs) (y:ys)+                    | x == y = unmerge xs ys+                    | otherwise = xl+                unmerge x y = x++prop_constStr (LitString x) = x == (toString . newSTMP $ x)++prop_emptyNulls (LitString x) (LitString y) i =+    (concat . replicate i' $ x) ==+      (toString . newSTMP . concat . replicate i' $ tmpl)+    where tmpl = x++"$"++y++"$"+          i' = min (abs i) 10++prop_fullNulls (LitString x) (LitString y) i =+    length y > 0 ==>+               (concat . replicate i' $ x++y) ==+               (toString . newSTMP . concat . replicate i' $ tmpl)+    where tmpl = x++"$"++y++";null='"++y++"'$"+          i' = min (abs i) 10++prop_substitution (LitString x) (LitString y) (LitString z) i =+    length y > 0 ==>+               (concat . replicate i' $ x++z) ==+               (toString . setAttribute y z .+                newSTMP . concat . replicate i' $ tmpl)+    where tmpl = x++"$"++y++"$"+          i' = min (abs i) 10++prop_separator (LitString x) (LitString y) (LitString z) i =+    length x > 0 ==>+               (concat . intersperse z . replicate i' $ y) ==+               (toString . setAttribute x (replicate i' y)+                . newSTMP $ tmpl)+    where tmpl = "$"++x++";separator='"++z++"'$"+          i' = min (abs i) 10++prop_comment (LitString x) (LitString y) (LitString z) =+    toString (newSTMP (x ++ "$!" ++ y ++ "!$" ++ z)) == x ++ z++prop_attribs (LitString x) i =+    toString (setManyAttrib (replicate i' ("f",x)) $ newSTMP "$f$")+                 == (concat . replicate i' $ x)+        where+          i' = min (abs i) 10++prop_ifelse a b c d =+    toString (setManyAttrib alist . newSTMP $ "$if(a)$a$elseif(b)$b$elseif(c)$c$else$$if(d)$d$else$e$endif$$endif$") == (fst . head . filter snd) alist+        where alist = [("a",a),("b",b),("c",c),("d",d),("e",True)]++prop_simpleGroup (LitString x) (LitString y) (LitString z) (LitString t) =+    length x > 0 && length y > 0 && length z > 0 && length t > 0+               && length (nub [x,y,z,t]) == 4 ==>+                  x == (toString . fromJust . getStringTemplate x $ grp)+    where tm   = newSTMP x+          tm'  = newSTMP $ "$"++y++"()$"+          tmIt = newSTMP "$it$"+          tm'' = newSTMP $ "$"++z++"():"++t++"()$"+          grp = groupStringTemplates [(y,tm),(z,tm'),(t,tmIt),(x,tm'')]++newtype LitChar = LitChar {unLitChar :: Char} deriving Show+instance Arbitrary LitChar where+  arbitrary = LitChar <$> choose ('a','z')++newtype LitString = LitString String deriving Show+instance Arbitrary LitString where+  arbitrary = LitString . map unLitChar <$> sized (\n -> choose (0,n) >>= vector)

@@ -0,0 +1,42 @@+{-# OPTIONS -O2 -fglasgow-exts #-}++module Units where+import System.IO+import qualified Data.Map as M++import Text.StringTemplate+import Text.StringTemplate.Classes+import Text.StringTemplate.Base+import Test.HUnit+import Control.Monad+import System.Environment++no_prop = toString (setAttribute "foo" "f" $ newSTMP "a$foo.bar$a")+          ~=? "aa"++one_prop = toString (setAttribute "foo" (M.singleton "bar" "baz") $ newSTMP "a$foo.bar$a")+           ~=? "abaza"++anon_tmpl = toString (setAttribute "foo" "f" $ newSTMP "a$foo:{{$foo$\\}}$a")+            ~=? "a{f}a"++setA = setAttribute "foo" ["a","b","c"]+func_first = toString (setA $ newSTMP "$first(foo)$") ~=? "a"+func_last = toString (setA $ newSTMP "$last(foo)$") ~=? "c"+func_rest = toString (setA $ newSTMP "$rest(foo)$") ~=? "bc"+func_length = toString (setA $ newSTMP "$length(foo)$") ~=? "3"+func_reverse = toString (setA $ newSTMP "$reverse(foo)$") ~=? "cba"++tests = TestList ["no_prop" ~: no_prop,+                  "one_prop" ~: one_prop,+                  "func_first" ~: func_first,+                  "func_last" ~: func_last,+                  "func_rest" ~: func_rest,+                  "func_reverse" ~: func_reverse,+                  "func_length" ~: func_length,+                  "anon_tmpl" ~: anon_tmpl]++main = do+  c <- runTestTT tests+  when (errors c > 0 || failures c > 0) $+    fail "Not all tests passed."