module Text.StringTemplate.Group
(groupStringTemplates, addSuperGroup, addSubGroup, setEncoderGroup,
mergeSTGroups, directoryGroup, optInsertGroup,
directoryGroupLazy, unsafeVolatileDirectoryGroup
) where
import Control.Applicative hiding ((<|>),many)
import Control.Arrow
import Data.Monoid
import Data.List
import System.Time
import System.FilePath
import System.Directory
import Data.IORef
import System.IO.Unsafe
import System.IO.Error
import qualified Data.Map as M
import Text.StringTemplate.Base
import Text.StringTemplate.Classes
(<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)
(<$$>) x y = ((<$>) . (<$>)) x y
sgInsert :: (String -> StFirst (StringTemplate a)) -> StringTemplate a -> StringTemplate a
sgInsert g st = let e = senv st in st {senv = e {sgen = sgen e `mappend` g} }
sgOverride :: STGroup a -> StringTemplate a -> StringTemplate a
sgOverride g st = let e = senv st in st {senv = e {sgen = g `mappend` sgen e} }
groupStringTemplates :: [(String,StringTemplate a)] -> STGroup a
groupStringTemplates xs = newGen
where newGen s = StFirst (M.lookup s ng)
ng = foldl' (flip $ uncurry M.insert) M.empty $
map (second $ sgInsert newGen) xs
directoryGroup :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroup path = groupStringTemplates <$>
(fmap <$> zip . (map dropExtension)
<*> mapM (newSTMP <$$> readFile)
=<< filter ((".st" ==) . takeExtension)
<$> getDirectoryContents path)
directoryGroupLazy :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupLazy path = groupStringTemplates <$>
(fmap <$> zip . (map dropExtension)
<*> mapM (unsafeInterleaveIO . (newSTMP <$$> readFile))
=<< filter ((".st" ==) . takeExtension)
<$> getDirectoryContents path)
addSuperGroup :: STGroup a -> STGroup a -> STGroup a
addSuperGroup f g = sgInsert g <$$> f
addSubGroup :: STGroup a -> STGroup a -> STGroup a
addSubGroup f g = sgOverride g <$$> f
mergeSTGroups :: STGroup a -> STGroup a -> STGroup a
mergeSTGroups f g = addSuperGroup f g `mappend` addSubGroup g f
optInsertGroup :: [(String, String)] -> STGroup a -> STGroup a
optInsertGroup opts f = optInsertTmpl opts <$$> f
setEncoderGroup :: (Stringable a) => (String -> String) -> STGroup a -> STGroup a
setEncoderGroup x f = setEncoder x <$$> f
unsafeVolatileDirectoryGroup :: Stringable a => String -> Int -> IO (STGroup a)
unsafeVolatileDirectoryGroup path i = return (cacheSTGroup i stfg)
where stfg = StFirst . Just . STMP (SEnv M.empty [] stfg id)
. parseSTMP ('$', '$') . unsafePerformIO . flip catch
(return . ("IO Error: " ++) . ioeGetErrorString)
. readFile . (path </>)
cacheSTGroup :: Int -> STGroup a -> STGroup a
cacheSTGroup m g = unsafePerformIO $ go <$> newIORef M.empty
where go r s = unsafePerformIO $ do
mp <- readIORef r
now <- getClockTime
maybe (udReturn now)
(\(t, st) -> if (tdSec . normalizeTimeDiff $
diffClockTimes now t) > m
then udReturn now
else return st)
. M.lookup s $ mp
where udReturn now = do
let st = g s
atomicModifyIORef r $
flip (,) () . M.insert s (now, st)
return st