packages feed

kontrakcja-templates (empty) → 0.1

raw patch · 11 files changed

+836/−0 lines, 11 filesdep +HStringTemplatedep +HUnitdep +MissingHsetup-changed

Dependencies added: HStringTemplate, HUnit, MissingH, base, bytestring, containers, directory, hslogger, html, mtl, old-time, parsec, string-templates, syb, test-framework, test-framework-hunit, test-framework-quickcheck2, time, transformers, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Mariusz Rak++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mariusz Rak nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example.hs view
@@ -0,0 +1,58 @@+import Text.StringTemplates.Fields+import Text.StringTemplates.TemplatesLoader+import Text.StringTemplates.Templates++import System.Directory+import Control.Monad.Identity+import Text.StringTemplate.Classes++-- applicable to renderTemplate, renderTemplateI functions+fields :: Monad m => Fields m ()+fields = do+  value "foo" "bar"+  valueM "foo2" $ return "bar2"+  object "foo3" $ do+           value "foo31" "bar31"+           value "foo32" "bar32"+  objects "foo4" [ do+                   value "foo411" "bar411"+                   value "foo412" "bar412"+                 , do+                   value "foo421" "bar421"+                   value "foo422" "bar422"+                 ]++-- applicable to renderTemplateMain functions+params :: [(String, SElem String)]+params = runIdentity $ runFields fields++textTemplates :: String+textTemplates =    "\"X\",\"COLUMN1\",\"COLUMN2\"\n"+                ++ "\"template1\",\"foo equals $foo$\",\"f==$foo$\"\n"+                ++ "\"template2\",\"foo3.foo31=$foo3.foo31$\"\n"++stringTemplates :: String+stringTemplates = "template3=$template1()$ and also $template2()$\n"+                  ++ "###\n"+                  ++ "template4=foo bar baz\n"+                  ++ "foo bar baz\n"++type MyMonad a = TemplatesT Identity a++main :: IO ()+main = do+  createDirectoryIfMissing True "/tmp/templates_test"+  createDirectoryIfMissing True "/tmp/templates_test/text_templates"+  createDirectoryIfMissing True "/tmp/templates_test/string_templates"++  writeFile "/tmp/templates_test/text_templates/test.csv" textTemplates+  writeFile "/tmp/templates_test/string_templates/templates.st" stringTemplates++  templates <- readGlobalTemplates "/tmp/templates_test/text_templates" ["/tmp/templates_test/string_templates/templates.st"] ["COLUMN1", "COLUMN2"]++  let x1 = runIdentity $ runTemplatesT ("COLUMN1", templates) $ renderTemplate "template3" fields+  putStrLn x1++  let x2 = runIdentity $ runTemplatesT ("COLUMN2", templates) $ renderTemplate "template3" fields -- template2 is taken from COLUMN1 because COLUMN2 doesn't define it+  putStrLn x2+
+ kontrakcja-templates.cabal view
@@ -0,0 +1,66 @@+Name:                kontrakcja-templates+Version:             0.1+Synopsis:+    Utilities for working with many HStringTemplate templates from files+Description:+    This library adds support for working with multiple templates in a single file,+    and .csv files containing mapping from template names to multiple template versions+    (e.g. for translations)++License:             BSD3+License-file:        LICENSE+Author:              Scrive+Maintainer:          bartek@scrive.com+Build-type:          Simple+Stability:           None+Category:            Web+Cabal-version:       >=1.9+extra-source-files:  example.hs++Library+  exposed-modules: Text.StringTemplates.Fields+                   Text.StringTemplates.Files+                   Text.StringTemplates.Templates+                   Text.StringTemplates.TemplatesLoader+                   Text.StringTemplates.TextTemplates+                   Text.StringTemplates.Utils++  hs-source-dirs:  src+  GHC-Options:     -Wall -rtsopts+  Extensions:      FlexibleInstances,+                   UndecidableInstances,+                   GeneralizedNewtypeDeriving+  build-depends:   base >= 4 && < 5,+                   HStringTemplate == 0.7.0,+                   containers >= 0.4.2.1 && < 0.5,+                   utf8-string == 0.3.6,+                   bytestring >= 0.9.2.1 && < 0.10,+                   mtl >= 2.0.1.0 && < 2.2,+                   transformers >= 0.2.2 && < 0.4,+                   old-time >= 1.1 && < 1.2,+                   directory >= 1.1.0.2 && < 1.2,+                   html >= 1.0.1.2 && < 1.1,+                   MissingH >= 1.1.1.0 && < 1.2,+                   parsec >= 3.1.1 && < 3.2++Test-Suite test-text-string-templates+  type:            exitcode-stdio-1.0+  hs-source-dirs:  test+  main-is:         Main.hs+  build-depends:   base >= 4 && < 5+  build-depends:   syb >= 0.1+  build-depends:   MissingH >= 1.0+  build-depends:   mtl >= 2.0+  build-depends:   time >= 1.0+  build-depends:   directory >= 1.0+  build-depends:   hslogger==1.1.4+  build-depends:   test-framework >= 0.4.1+  build-depends:   test-framework-quickcheck2+  build-depends:   test-framework-hunit+  build-depends:   HUnit+  build-depends:   string-templates+  build-depends:   old-time+  build-depends:   HStringTemplate == 0.7.0+  build-depends:   containers >= 0.4.2.1 && < 0.5++  extensions:      FlexibleInstances
+ src/Text/StringTemplates/Fields.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverlappingInstances #-}+-- | Module for easy creating template params+--+-- Example usage:+--+-- @+-- \-- applicable to renderTemplate, renderTemplateI functions+-- fields :: Fields Identity ()+-- fields = do+--   value \"foo\" \"bar\"+--   valueM \"foo2\" $ return \"bar2\"+--   object \"foo3\" $ do+--            value \"foo31\" \"bar31\"+--            value \"foo32\" \"bar32\"+--   objects \"foo4\" [ do+--                    value \"foo411\" \"bar411\"+--                    value \"foo412\" \"bar412\"+--                  , do+--                    value \"foo421\" \"bar421\"+--                    value \"foo422\" \"bar422\"+--                  ]+-- +-- \-- applicable to renderTemplateMain functions+-- params :: [(String, SElem String)]+-- params = runIdentity $ runFields fields+-- @+module Text.StringTemplates.Fields ( Fields+                                   , runFields+                                   , value+                                   , valueM+                                   , object+                                   , objects+                                   ) where++import Control.Applicative+import Control.Monad.Reader+import Control.Monad.State.Strict+import Text.StringTemplate.Base hiding (ToSElem, toSElem, render)+import Text.StringTemplate.Classes hiding (ToSElem, toSElem)+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BS+import qualified Data.Map as M+import qualified Text.StringTemplate.Classes as HST++import Text.StringTemplates.TemplatesLoader ()++-- | Simple monad transformer that collects info about template params+newtype Fields m a = Fields (StateT [(String, SElem String)] m a)+  deriving (Applicative, Functor, Monad, MonadTrans)++-- | get all collected template params+runFields :: Monad m => Fields m () -> m [(String, SElem String)]+runFields (Fields f) = execStateT f []++-- | create a new named template parameter+value :: (Monad m, ToSElem a) => String -> a -> Fields m ()+value name val = Fields $ modify ((name, toSElem val) :)++-- | create a new named template parameter (monad version)+valueM :: (Monad m, ToSElem a) => String -> m a -> Fields m ()+valueM name mval = lift mval >>= value name++-- | collect all params under a new namespace+object :: Monad m => String -> Fields m () -> Fields m ()+object name obj = Fields $ do+  val <- M.fromList `liftM` lift (runFields obj)+  modify ((name, toSElem val) :)++-- | collect all params under a new list namespace+objects :: Monad m => String -> [Fields m ()] -> Fields m ()+objects name objs = Fields $ do+  vals <- mapM (liftM M.fromList . lift . runFields) objs+  modify ((name, toSElem vals) :)++-- | Important Util. We overide default serialisation to support serialisation of bytestrings .+-- | We use ByteString with UTF all the time but default is Latin-1 and we get strange chars+-- | after rendering. !This will not always work with advanced structures.! So always convert to String.++class ToSElem a where+  toSElem :: (Stringable b) => a -> SElem b++instance (HST.ToSElem a) => ToSElem a where+  toSElem = HST.toSElem++instance ToSElem BS.ByteString where+  toSElem = HST.toSElem . BS.toString++instance ToSElem (Maybe BS.ByteString) where+  toSElem = HST.toSElem . fmap BS.toString++instance ToSElem [BS.ByteString] where+  toSElem = toSElem . fmap BS.toString++instance ToSElem String where+  toSElem l = HST.toSElem l++instance (HST.ToSElem a) => ToSElem [a] where+  toSElem l  = LI $ map HST.toSElem l++instance (HST.ToSElem a) => ToSElem (M.Map String a) where+  toSElem m = SM $ M.map HST.toSElem m
+ src/Text/StringTemplates/Files.hs view
@@ -0,0 +1,75 @@+-- |module for reading many template definitions from files+module Text.StringTemplates.Files (getTemplates) where++import Data.Char (isAlphaNum)+import Data.List (intercalate, isPrefixOf)+import Data.Maybe (maybeToList)+import System.IO++-- |parses template definitions read from the file path (using utf8)+-- definitions are separated by >=1 lines starting with '#'+-- if first line of definition looks like foo=bar, then it returns+-- (foo, bar ++ rest of the lines (from definition) concatenated)+-- broken definitons are skipped+--+-- Example template file:+--+-- @+-- foo=+-- \<html>+--   \<body>+--     \<h1> hello \</h1>+--   \</body>+-- \</html>+-- ###+-- bar=\<b>BAR\</b>+-- @+getTemplates :: FilePath -- ^ file path of a file with template definitions+             -> IO [(String, String)]+getTemplates fp =+    withFile fp ReadMode $ \handle -> do+        hSetEncoding handle utf8+        parseTemplates handle++-- parses template definitions from the handle+-- definitions are separated by >=1 lines starting with '#'+-- if first line of definition looks like foo=bar, then it returns+-- (foo, bar ++ rest of the lines (from definition) concatenated)+-- broken definitons are skipped+parseTemplates :: Handle -> IO [(String,String)]+parseTemplates handle = do+    e <- hIsEOF handle+    if (e)+        then return []+        else do+               t  <- parseTemplate handle+               ts <- parseTemplates handle+               return $ (maybeToList t) ++ ts++-- reads many lines from the handle, stopping at+-- first line starting with '#', (read from the handle, not used)+-- if line should looks like "foo=bar", then it returns+-- Just (foo, bar ++ rest of the lines concatenated)+-- otherwise Nothing+parseTemplate :: Handle -> IO (Maybe (String, String))+parseTemplate handle = do+    ls <- parseLines handle+    let (name,t) = break (==  '=') $ head ls+    if (null ls || null (name) || null t)+        then return Nothing+        else do+            let template = intercalate "\r\n" ((tail t): (tail ls))+            return $ Just (filter isAlphaNum name,template)++-- returns list of lines read from the handle+-- stops at first line starting with '#'+-- (it's read from the handle, but not returned)+parseLines :: Handle -> IO [String]+parseLines handle = do+    l <- hGetLine handle+    e <- hIsEOF handle+    if (isPrefixOf ("#") l)+        then return []+        else if e+            then return [l]+            else fmap ((:) l) (parseLines handle)
+ src/Text/StringTemplates/Templates.hs view
@@ -0,0 +1,155 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Templates.Templates+-- Maintainer  :  bartek@skrivapa.se+-- Stability   :  development+-- Portability :  portable+--+-- This is main templating module. It provides basic interface for+-- generation templates (RenderTemplate) with 'renderTemplate'+-- function. We also provide types for templates and few functions for+-- loading and testing+--+-- HOW TO USE TEMPLATING SYSTEM+--+-- 1) There is a folder called templates, All templates files (*.st) are there. Each files contains many templates+--    definitions, and there must be line starting with # between each two templates.+--    Template definition has form 'nameOfTemplate=bodyOfTemplate'.+--+-- 2) Template body is just String Template and you should be able to find more+--    info at http://www.haskell.org/haskellwiki/HStringTemplate+--+-- 3) All templates are in a global scope. Watch out for conflicting names.+--    On dev computers they are loaded on every request, so one can change them without stoping server.+--+-- 4) To generate a template in haskell call renderTemplate.+--       First param is a set of all templates. Usually you can get it from 'Context'.+--       Next is a name of template that You wan't to render.+--       Last one is some for of list of params.+--       As a result you get IO String.+--        If template will fail You will get error info inside. But this is only for syntax errors.+--        If You will forget a param there will be info in log, and template set param value to something empty.+--+--+-- FIELDS+--+-- Current policy is to use fields. You can find usage of+-- [(String,String)] as params and also composition of setAttribute+-- functions in a code.  This are old concepts and will be droped at+-- some point.+--+-- How to user fields:+--  - there is one function ('field') that sets one field+--  - fields form a monad so you can use do notation for setting many fields+--  - value of a field can be almoust everything (String, Int, Maybe, List, Map, types that are instances of Data and Typeable etc)+--  - IO wrapped values and fields can be also a values of a field.+--+-- Example+--+-- >      userView tempates user =+-- >        renderTemplate templates "userView" $ do+-- >          userFields+-- >+-- >      userFields user = do+-- >        field "name" $ username user+-- >        field "company" $ usercompany user+-- >        field "documents" $ map (documentFields) getUserDocumentsFromDB+-- >+-- >      documentFields document = do+-- >        field "id" $ documentid document+-- >        field "title" $ documenttitle document+--+--+-- Why we want to use fields+--      - They force reuse. We write documentFields, and reuse it every time we want to pass document info to template.+--      - Fields can be extended. If I want to have extended info about user I use 'userFields' to set basic info and+--        then add advanced fields+--      - No need to first bind from IO, then pass to template+--      - They support advanced structures like lists and maybe's+--+--+-- Some extra info:+--  In templates use maybe. You can use 'if' in template body to check for Nothing+--  Always change ByteString to String. We have a problems with encoding, so please watch for this.+--+-- Please also see example.hs for a running example+-----------------------------------------------------------------------------+module Text.StringTemplates.Templates ( Fields+                                      , runFields+                                      , TemplatesMonad(..)+                                      , renderTemplate+                                      , renderTemplate_+                                      , renderTemplateI+                                      , TemplatesT(..)+                                      , runTemplatesT+                                      , renderHelper+                                      ) where++import Control.Monad.Trans.Maybe+import Text.StringTemplate.Base hiding (ToSElem, toSElem, render)+import Text.StringTemplates.TemplatesLoader++import Text.StringTemplates.Fields+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Identity+import Control.Monad.Error++-- | simple reader monad class that provides access to templates+class (Functor m, Monad m) => TemplatesMonad m where+  getTemplates      :: m Templates -- ^ get templates (for text templates default column name is used)+  getTextTemplatesByColumn :: String -> m Templates -- ^ get templates (for text templates specified column name is used)++instance TemplatesMonad m => TemplatesMonad (MaybeT m) where+  getTemplates = lift getTemplates+  getTextTemplatesByColumn = lift . getTextTemplatesByColumn++instance (TemplatesMonad m , Error e) => TemplatesMonad (ErrorT e m) where+  getTemplates = lift getTemplates+  getTextTemplatesByColumn = lift . getTextTemplatesByColumn++-- | renders a template by name+renderTemplate :: TemplatesMonad m =>+                 String     -- ^ template name+               -> Fields m () -- ^ template params+               -> m String+renderTemplate name fields = do+  ts <- getTemplates+  renderHelper ts name fields++-- | renders a template by name (params function cannot use side effects)+renderTemplateI :: TemplatesMonad m =>+                  String            -- ^ template name+                -> Fields Identity () -- ^ template params+                -> m String+renderTemplateI name fields = do+  ts <- getTemplates+  return $ renderTemplateMain ts name ([]::[(String, String)]) (setManyAttrib $ runIdentity $ runFields fields)++-- | renders a template by name without any params+renderTemplate_ :: TemplatesMonad m =>+                  String -- ^ template name+                -> m String+renderTemplate_ name = renderTemplate name $ return ()++renderHelper :: Monad m => Templates -> String -> Fields m () -> m String+renderHelper ts name fields = do+  attrs <- runFields fields+  return $ renderTemplateMain ts name ([]::[(String, String)]) (setManyAttrib attrs)++-- | Simple implementation of TemplatesMonad+newtype TemplatesT m a = TemplatesT { unTT :: ReaderT (String, GlobalTemplates) m a }+    deriving (Applicative, Functor, Monad, MonadIO, MonadTrans)++runTemplatesT :: (Functor m, Monad m) =>+                (String, GlobalTemplates) -- ^ (default column name, global templates)+              -> TemplatesT m a -> m a+runTemplatesT ts action = runReaderT (unTT action) ts++instance (Functor m, Monad m) => TemplatesMonad (TemplatesT m) where+  getTemplates = TemplatesT $ do+    (column, ts) <- ask+    return $ localizedVersion column ts+  getTextTemplatesByColumn column = TemplatesT $ do+    (_, ts) <- ask+    return $ localizedVersion column ts
+ src/Text/StringTemplates/TemplatesLoader.hs view
@@ -0,0 +1,96 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Module for reading templates from files+module Text.StringTemplates.TemplatesLoader ( Templates+                                            , GlobalTemplates+                                            , localizedVersion+                                            , readGlobalTemplates+                                            , renderTemplateMain+                                            , getTemplatesModTime+                                            ) where++import Data.List (isSuffixOf)+import Text.StringTemplate+import Text.StringTemplate.Classes+import Control.Monad+import Control.Monad.IO.Class+import qualified Data.Map as Map+import Text.Html (stringToHtmlString)+import System.Time+import Text.StringTemplates.Files+import Text.StringTemplates.TextTemplates+import Text.StringTemplates.Utils++-- | Group of string templates+type Templates = STGroup String+-- | Global map of templates (for a project),+--   indexed by a column name (for text string templates, see TextTemplates for doc)+type GlobalTemplates = Map.Map String Templates++-- | Retrieve templates for specified column name+localizedVersion :: String -> GlobalTemplates -> Templates+localizedVersion col mtemplates = mtemplates Map.! col++-- Fixme: Make this do only one read of all files !!+-- | Reads text templates and templates from files (see TextTemplates and Files modules docs respectively).+--   List of text columns is used to load text templates for every column (the rest of them are+--   used as fallback columns)+readGlobalTemplates :: MonadIO m =>+                      FilePath   -- ^ dir path to recursively scan for .csv files containing text templates+                    -> FilePath   -- ^ dir path to recursively scan for .st files containing string templates+                    -> m GlobalTemplates+readGlobalTemplates textTemplatesFilePath templatesDirPath  = do+  files <- liftIO $ directoryFilesRecursive templatesDirPath+  let templatesFilePaths = filter (".st" `isSuffixOf`) files+  ts <- liftIO $ mapM getTemplates templatesFilePaths+  tts <- liftIO $ getTextTemplates textTemplatesFilePath+  liftM Map.fromList $ forM (Map.keys tts) $ \col -> do+    checked <- mapM newCheckedTemplate $ (concat ts) ++ (tts Map.! col)+    return ((col, groupStringTemplates checked)::(String, Templates))++newCheckedTemplate :: Monad m => (String, String) -> m (String, StringTemplate String)+newCheckedTemplate (n,v) = do+  let t = newSTMP v+      (errors, _, _) = checkTemplate t+  maybe (return ()) (\e -> fail $ "newCheckedTemplate: problem with template " ++ show n ++ ": " ++ e) errors+  return (n,t)++-- | Returns the latest modification time across all template files+getTemplatesModTime :: FilePath   -- ^ path to dir containing .csv files with template files+                    -> FilePath -- ^ dir path to recursively scan for .st files containing string templates+                    -> IO ClockTime+getTemplatesModTime textTemplatesDir templatesDirPath = do+    mt1 <- getRecursiveMTime templatesDirPath+    mt2 <- getRecursiveMTime textTemplatesDir+    return $ maximum $ [mt1,mt2]++-- | main template rendering function.+--   renders template by name (it's an error to render template that's not present in templates group),+--   and using list of named template params. simple 'noescape' template is added for convenience+renderTemplateMain :: ToSElem a =>+                     Templates     -- ^ group of templates+                   -> String        -- ^ template name+                   -> [(String, a)] -- ^ named template params+                   -> (StringTemplate String -> StringTemplate String) -- ^ additional template altering function+                   -> String -- ^ rendered template+renderTemplateMain ts name params f = case mt of+  Just t  -> render $ f (setManyAttrib params t)+  Nothing -> error  $ "No template named " ++ name+  where+    ts' = setEncoderGroup stringToHtmlString ts+    noescape = groupStringTemplates [("noescape", newSTMP "$it$" :: StringTemplate String)]+    mt = getStringTemplate name $ mergeSTGroups noescape ts'++{- For some reasons the SElem a is not of class ToSElem -}+instance (Stringable a) => ToSElem (SElem a) where+  toSElem (STR a) = (STR a)+  toSElem (BS a) = (BS a)+  toSElem (STSH a) = (STSH a)+  toSElem (SM a) = (SM $ fmap (toSElem) a)+  toSElem (LI a) = (LI $ fmap (toSElem) a)+  toSElem (SBLE a) = (SBLE $ convert a)+  toSElem (SNAT a) = (SNAT $ convert a)+  toSElem (TXT a) = (STR $ convert a)+  toSElem SNull = SNull++convert :: (Stringable a, Stringable b) => a -> b+convert = stFromString . stToString
+ src/Text/StringTemplates/TextTemplates.hs view
@@ -0,0 +1,78 @@+-- | module for reading dictionaries of templates from csv files.+-- may be used for reading of csv containing translation templates+module Text.StringTemplates.TextTemplates (getTextTemplates) where++import Data.Char (isSpace, isControl)+import Data.List (isSuffixOf)+import System.IO+import Data.Map (Map)+import qualified Data.Map as M++import Text.ParserCombinators.Parsec (parse)+import Data.CSV (csvFile)++import Text.StringTemplates.Utils++type Schema = [String]++-- | Searches recursively a directory for .csv files and+-- parses them with the following format:+--+-- @+-- \"WHATEVER\", \"column_name1\", \"column_name2\", ...+-- \"name\",       \"value1\",       \"value2\",       ...+-- \"name2\",      \"value3\",       \"value4\",       ...+-- ...+-- @+--+-- and returns a list of (name, value) pairs for the chosen column_name+-- (across all files) (e.g. for \"column_name1\" from example,+-- it would return [(\"name\", \"value1\"), (\"name2\", \"value3\")])+-- if the value is missing for column_name (but it's present in other columns),+-- tries values from other columns (in order)+getTextTemplates :: FilePath -- ^ path of a directory to search for .csv files+                    -> IO (Map String [(String, String)])+getTextTemplates path  = do+  paths <- directoryFilesRecursive path+  M.unionsWith (++) `fmap` mapM getTextTemplatesFromFile paths++-- Parses a .csv file with the following format:+-- (line1): WHATEVER, column_name1, column_name2, ...+-- (lineN): name,     value1,       value2,       ...+-- and returns a map from column name to a list of (name, value) pairs+getTextTemplatesFromFile :: FilePath -> IO (Map String [(String, String)])+getTextTemplatesFromFile path | not $ ".csv" `isSuffixOf` path = return $ M.empty+                              | otherwise = do+  csv <- basicCSVParser path+  case csv of+    [] -> error $ "CSV parsing error in" ++ path ++ "\nEmpty file"+    schemaRow:rows ->+        case schemaRow of+          [] -> error $ "CSV parsing error in" ++ path ++ "\nEmpty schema/first line"+          _:schema -> return $ parseTextTemplates schema rows++-- Takes a schema (list of column names) and a list of rows+-- (row looks like: [name, value1, value2...]+-- and returns a map from column name to a list of (name, value) pairs+parseTextTemplates :: Schema -> [[String]] -> Map String [(String, String)]+parseTextTemplates schema = M.unionsWith (++) . map aux+    where aux :: [String] -> Map String [(String, String)]+          aux [] = error "parseTextTemplates: row cannot be empty"+          aux (name:fields) =+              M.fromList $ zip schema $ map makeList $ filter goodField $+                 zip (repeat name) $ map fixField fields+          fixField = replace '\n' ' '+          goodField (_, f) = any notSpaceOrControl f || (length f >= 6)+          notSpaceOrControl c = not $ isSpace c || isControl c+          replace a b = map $ \x -> if x == a then b else x+          makeList x = [x]++-- Parses csv from filepath (using utf-8)+basicCSVParser :: FilePath -> IO [[String]]+basicCSVParser path =+    withFile path ReadMode $ \h -> do+    hSetEncoding h utf8+    content <- hGetContents h+    case parse csvFile path content of+        Right csv -> return csv+        Left s -> error $ "CSV parse error in " ++ path ++ ": " ++ show s
+ src/Text/StringTemplates/Utils.hs view
@@ -0,0 +1,35 @@+{-+  Util modul. Shold be dropped when misc is released as package.+-}++module Text.StringTemplates.Utils (directoryEntriesRecursive,directoryFilesRecursive,getRecursiveMTime) where++import System.Directory+import Data.List (isSuffixOf)+import System.Time (ClockTime)++directoryEntriesRecursive :: FilePath -- ^ dir path to be searched for recursively+                          -> IO ([FilePath], [FilePath]) -- ^ (list of all subdirs, list of all files)+directoryEntriesRecursive path | "." `isSuffixOf` path = return ([], [])+                               | otherwise = do+  isDir <- doesDirectoryExist path+  if isDir then do+      entries <- getDirectoryContents path+      let properEntries = map ((path ++ "/")++) entries+      results <- mapM directoryEntriesRecursive properEntries+      let (dirs, files) = biConcat results+      return (path:dirs, files)+   else+      return ([], [path])+ where biConcat = (\(x, y) -> (concat x, concat y)) . unzip++directoryFilesRecursive :: FilePath -- ^ dir path to be searched for recursively+                        -> IO [FilePath] -- ^ list of all files in that dir+directoryFilesRecursive path = snd `fmap` directoryEntriesRecursive path++-- | Check recursively time of modification of any file(or dir) in directory+getRecursiveMTime :: FilePath -> IO ClockTime+getRecursiveMTime path = do+  (dirs, files) <- directoryEntriesRecursive path+  mtimes <- mapM getModificationTime $ dirs ++ files+  return $ maximum mtimes
+ test/Main.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE StandaloneDeriving #-}+import System.IO.HVFS.Utils+import Data.List+import Control.Monad+import Control.Monad.Identity++import Test.Framework as TF (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Control.Exception+import System.IO.HVFS.Utils+import Control.Monad+import Data.Either+import Data.Either.Utils+import Data.Functor+import System.Directory+import Data.List+import qualified Data.Map as Map++import Text.StringTemplates.Files+import Text.StringTemplates.TextTemplates+import Text.StringTemplates.Fields+import Text.StringTemplates.TemplatesLoader+import Text.StringTemplates.Templates hiding (getTemplates)+import Text.StringTemplate.Classes (SElem(..), STShow(..))++main :: IO ()+main = defaultMain tests++tests :: [TF.Test]+tests = [ testGroup "Test order" [ testCase "getTextTemplatesFor" test_getTemplates+                                 , testCase "getTextTemplatesFor" test_getTextTemplatesFor+                                 , testCase "test fields" test_fields+                                 , testCase "readGlobalTemplates" test_readGlobalTemplates+                                 ]+        ]++textTemplates :: String+textTemplates =    "\"X\",\"COLUMN1\",\"COLUMN2\"\n"+                ++ "\"template1\",\"foo equals $foo$\",\"f==$foo$\"\n"+                ++ "\"template2\",\"foo3.foo31=$foo3.foo31$\"\n"++stringTemplates :: String+stringTemplates = "template3=$template1()$ and also $template2()$\n"+                  ++ "###\n"+                  ++ "template4=foo bar baz\n"+                  ++ "foo bar baz\n"++fields :: Monad m => Fields m ()+fields = do+  value "foo" "bar"+  valueM "foo2" $ return "bar2"+  object "foo3" $ do+           value "foo31" "bar31"+           value "foo32" "bar32"+  objects "foo4" [ do+                   value "foo411" "bar411"+                   value "foo412" "bar412"+                 , do+                   value "foo421" "bar421"+                   value "foo422" "bar422"+                 ]++deriving instance Eq (SElem String)+deriving instance Show (SElem String)+deriving instance Show STShow+instance Eq STShow where+    (==) = undefined++setUp :: IO ()+setUp = do+  createDirectoryIfMissing True "/tmp/templates_test"+  createDirectoryIfMissing True "/tmp/templates_test/text_templates"+  createDirectoryIfMissing True "/tmp/templates_test/string_templates"++  writeFile "/tmp/templates_test/text_templates/test.csv" textTemplates+  writeFile "/tmp/templates_test/string_templates/templates.st" stringTemplates++tearDown :: IO ()+tearDown = do+  removeDirectoryRecursive "/tmp/templates_test"++mktest assertion = bracket setUp (const tearDown) (const assertion)++test_getTemplates :: Assertion+test_getTemplates = mktest $ do+  ts <- getTemplates "/tmp/templates_test/string_templates/templates.st"+  assertEqual "getTemplates" ts+                  [ ("template3", "$template1()$ and also $template2()$")+                  , ("template4", "foo bar baz\r\nfoo bar baz")+                  ]++test_getTextTemplatesFor :: Assertion+test_getTextTemplatesFor = mktest $ do+  ts1 <- getTextTemplatesFor "/tmp/templates_test/text_templates" "COLUMN1" ["COLUMN2"]+  assertEqual "getTextTemplatesFor1" ts1+                  [ ("template1", "foo equals $foo$")+                  , ("template2", "foo3.foo31=$foo3.foo31$")+                  ]+  ts2 <- getTextTemplatesFor "/tmp/templates_test/text_templates" "COLUMN2" []+  assertEqual "getTextTemplatesFor2" ts2 [("template1", "f==$foo$")]+  ts3 <- getTextTemplatesFor "/tmp/templates_test/text_templates" "COLUMN2" ["COLUMN1"]+  assertEqual "getTextTemplatesFor3" ts3+                  [ ("template1", "f==$foo$")+                  , ("template2", "foo3.foo31=$foo3.foo31$")+                  ]++test_fields :: Assertion+test_fields = do+  let fs = runIdentity $ runFields fields+  assertEqual "test fields" (Map.fromList fs) $ Map.fromList+    [ ("foo", STR "bar")+    , ("foo2", STR "bar2")+    , ("foo3", SM $ Map.fromList [ ("foo31", STR "bar31")+                                 , ("foo32", STR "bar32")+                                 ])+    , ("foo4", LI [ SM $ Map.fromList [ ("foo411", STR "bar411")+                                      , ("foo412", STR "bar412")+                                      ]+                  , SM $ Map.fromList [ ("foo421", STR "bar421")+                                      , ("foo422", STR "bar422")+                                      ]+                  ])+    ]++test_readGlobalTemplates :: Assertion+test_readGlobalTemplates = mktest $ do+  ts <- readGlobalTemplates "/tmp/templates_test/text_templates" ["/tmp/templates_test/string_templates/templates.st"] ["COLUMN1", "COLUMN2"]+  let render col name = runIdentity $ runTemplatesT ("COLUMN" ++ show col, ts) $ renderTemplate name fields+  assertEqual "templates1" "foo equals bar" $ render 1 "template1"+  assertEqual "templates2" "foo3.foo31=bar31" $ render 1 "template2"+  assertEqual "templates3" "foo equals bar and also foo3.foo31=bar31" $ render 1 "template3"+  assertEqual "templates4" "foo bar baz\r\nfoo bar baz" $ render 1 "template4"++  assertEqual "templates5" "f==bar" $ render 2 "template1"+  assertEqual "templates6" "foo3.foo31=bar31" $ render 2 "template2"+  assertEqual "templates7" "f==bar and also foo3.foo31=bar31" $ render 2 "template3"+  assertEqual "templates8" "foo bar baz\r\nfoo bar baz" $ render 2 "template4"