{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}
module Text.StringTemplate.Group
(groupStringTemplates, addSuperGroup, addSubGroup, setEncoderGroup,
mergeSTGroups, directoryGroup, directoryGroupExt, optInsertGroup,
directoryGroupLazy, directoryGroupLazyExt, directoryGroupRecursive,
directoryGroupRecursiveExt, directoryGroupRecursiveLazy,
directoryGroupRecursiveLazyExt,
unsafeVolatileDirectoryGroup, nullGroup
) where
import Control.Applicative
import Control.Arrow
import qualified Control.Exception as CE
import Control.Monad
import Data.Monoid
import Data.List
import System.FilePath
import System.Directory
import Data.IORef
import System.IO
import System.IO.Unsafe
import System.IO.Error
import qualified Data.Map as M
import Data.Time
import Text.StringTemplate.Base
import Text.StringTemplate.Classes
(<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)
<$$> :: forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
(<$$>) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)
readFileUTF :: FilePath -> IO String
readFileUTF :: FilePath -> IO FilePath
readFileUTF FilePath
f = do
Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
f IOMode
ReadMode
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
Handle -> IO FilePath
hGetContents Handle
h
readFileStrictly :: FilePath -> IO String
readFileStrictly :: FilePath -> IO FilePath
readFileStrictly FilePath
f = do
FilePath
x <- FilePath -> IO FilePath
readFileUTF FilePath
f
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
x seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
groupFromFiles :: Stringable a => (FilePath -> IO String) -> [(FilePath,String)] -> IO (STGroup a)
groupFromFiles :: forall a.
Stringable a =>
(FilePath -> IO FilePath)
-> [(FilePath, FilePath)] -> IO (STGroup a)
groupFromFiles FilePath -> IO FilePath
rf [(FilePath, FilePath)]
fs = forall a. [(FilePath, StringTemplate a)] -> STGroup a
groupStringTemplates forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FilePath, FilePath)]
fs (\(FilePath
f,FilePath
fname) -> do
StringTemplate a
stmp <- forall a. Stringable a => FilePath -> StringTemplate a
newSTMP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
rf FilePath
f
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
fname, StringTemplate a
stmp))
getTmplsRecursive :: FilePath -> FilePath -> FilePath -> IO [(FilePath, FilePath)]
getTmplsRecursive :: FilePath -> FilePath -> FilePath -> IO [(FilePath, FilePath)]
getTmplsRecursive FilePath
ext FilePath
base FilePath
fp = do
[FilePath]
dirContents <- forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
".") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
fp
[FilePath]
subDirs <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
fp FilePath -> FilePath -> FilePath
</>)) [FilePath]
dirContents
[(FilePath, FilePath)]
subs <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
x -> FilePath -> FilePath -> FilePath -> IO [(FilePath, FilePath)]
getTmplsRecursive FilePath
ext (FilePath
base FilePath -> FilePath -> FilePath
</> FilePath
x) (FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
x)) [FilePath]
subDirs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
fp FilePath -> FilePath -> FilePath
</>) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (\FilePath
x -> FilePath
base FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropExtension FilePath
x)) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath
ext forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
dirContents)
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
subs
groupStringTemplates :: [(String,StringTemplate a)] -> STGroup a
groupStringTemplates :: forall a. [(FilePath, StringTemplate a)] -> STGroup a
groupStringTemplates [(FilePath, StringTemplate a)]
xs = FilePath -> StFirst (StringTemplate a)
newGen
where newGen :: FilePath -> StFirst (StringTemplate a)
newGen FilePath
s = forall a. Maybe a -> StFirst a
StFirst (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
s Map FilePath (StringTemplate a)
ng)
ng :: Map FilePath (StringTemplate a)
ng = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (forall a. Monoid a => a -> a -> a
`mappend` FilePath -> StFirst (StringTemplate a)
newGen)) [(FilePath, StringTemplate a)]
xs
directoryGroup :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroup :: forall a. Stringable a => FilePath -> IO (STGroup a)
directoryGroup = forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupExt FilePath
".st"
directoryGroupExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupExt :: forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupExt FilePath
ext FilePath
path =
forall a.
Stringable a =>
(FilePath -> IO FilePath)
-> [(FilePath, FilePath)] -> IO (STGroup a)
groupFromFiles FilePath -> IO FilePath
readFileStrictly forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
(</>) FilePath
path forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FilePath -> FilePath
takeBaseName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath
ext forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
directoryGroupLazy :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupLazy :: forall a. Stringable a => FilePath -> IO (STGroup a)
directoryGroupLazy = forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupLazyExt FilePath
".st"
directoryGroupLazyExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupLazyExt :: forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupLazyExt FilePath
ext FilePath
path =
forall a.
Stringable a =>
(FilePath -> IO FilePath)
-> [(FilePath, FilePath)] -> IO (STGroup a)
groupFromFiles FilePath -> IO FilePath
readFileUTF forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
(</>) FilePath
path forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FilePath -> FilePath
takeBaseName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath
ext forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
directoryGroupRecursive :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupRecursive :: forall a. Stringable a => FilePath -> IO (STGroup a)
directoryGroupRecursive = forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveExt FilePath
".st"
directoryGroupRecursiveExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveExt :: forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveExt FilePath
ext FilePath
path = forall a.
Stringable a =>
(FilePath -> IO FilePath)
-> [(FilePath, FilePath)] -> IO (STGroup a)
groupFromFiles FilePath -> IO FilePath
readFileStrictly forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> FilePath -> IO [(FilePath, FilePath)]
getTmplsRecursive FilePath
ext FilePath
"" FilePath
path
directoryGroupRecursiveLazy :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupRecursiveLazy :: forall a. Stringable a => FilePath -> IO (STGroup a)
directoryGroupRecursiveLazy = forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveLazyExt FilePath
".st"
directoryGroupRecursiveLazyExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveLazyExt :: forall a. Stringable a => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveLazyExt FilePath
ext FilePath
path = forall a.
Stringable a =>
(FilePath -> IO FilePath)
-> [(FilePath, FilePath)] -> IO (STGroup a)
groupFromFiles FilePath -> IO FilePath
readFileUTF forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> FilePath -> IO [(FilePath, FilePath)]
getTmplsRecursive FilePath
ext FilePath
"" FilePath
path
addSuperGroup :: STGroup a -> STGroup a -> STGroup a
addSuperGroup :: forall a. STGroup a -> STGroup a -> STGroup a
addSuperGroup STGroup a
f STGroup a
g = forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (forall a. Monoid a => a -> a -> a
`mappend` STGroup a
g) forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> STGroup a
f
addSubGroup :: STGroup a -> STGroup a -> STGroup a
addSubGroup :: forall a. STGroup a -> STGroup a -> STGroup a
addSubGroup STGroup a
f STGroup a
g = forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (STGroup a
g forall a. Monoid a => a -> a -> a
`mappend`) forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> STGroup a
f
mergeSTGroups :: STGroup a -> STGroup a -> STGroup a
mergeSTGroups :: forall a. STGroup a -> STGroup a -> STGroup a
mergeSTGroups STGroup a
f STGroup a
g = forall a. STGroup a -> STGroup a -> STGroup a
addSuperGroup STGroup a
f STGroup a
g forall a. Monoid a => a -> a -> a
`mappend` forall a. STGroup a -> STGroup a -> STGroup a
addSubGroup STGroup a
g STGroup a
f
optInsertGroup :: [(String, String)] -> STGroup a -> STGroup a
optInsertGroup :: forall a. [(FilePath, FilePath)] -> STGroup a -> STGroup a
optInsertGroup [(FilePath, FilePath)]
opts STGroup a
f = (forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (forall a. [(FilePath, FilePath)] -> STGroup a -> STGroup a
optInsertGroup [(FilePath, FilePath)]
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
[(FilePath, FilePath)] -> StringTemplate a -> StringTemplate a
optInsertTmpl [(FilePath, FilePath)]
opts) forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> STGroup a
f
setEncoderGroup :: (Stringable a) => (a -> a) -> STGroup a -> STGroup a
setEncoderGroup :: forall a. Stringable a => (a -> a) -> STGroup a -> STGroup a
setEncoderGroup a -> a
x STGroup a
f = (forall a.
(STGroup a -> STGroup a) -> StringTemplate a -> StringTemplate a
inSGen (forall a. Stringable a => (a -> a) -> STGroup a -> STGroup a
setEncoderGroup a -> a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Stringable a =>
(a -> a) -> StringTemplate a -> StringTemplate a
setEncoder a -> a
x) forall (f1 :: * -> *) (f :: * -> *) a b.
(Functor f1, Functor f) =>
(a -> b) -> f (f1 a) -> f (f1 b)
<$$> STGroup a
f
nullGroup :: Stringable a => STGroup a
nullGroup :: forall a. Stringable a => STGroup a
nullGroup FilePath
x = forall a. Maybe a -> StFirst a
StFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => FilePath -> StringTemplate a
newSTMP forall a b. (a -> b) -> a -> b
$ FilePath
"Could not find template: " forall a. [a] -> [a] -> [a]
++ FilePath
x
unsafeVolatileDirectoryGroup :: Stringable a => FilePath -> Int -> IO (STGroup a)
unsafeVolatileDirectoryGroup :: forall a. Stringable a => FilePath -> Int -> IO (STGroup a)
unsafeVolatileDirectoryGroup FilePath
path Int
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. STGroup a -> STGroup a -> STGroup a
addSubGroup STGroup a
extraTmpls forall a b. (a -> b) -> a -> b
$ forall a. STGroup a -> STGroup a
cacheSTGroup STGroup a
stfg
where stfg :: STGroup a
stfg = forall a. Maybe a -> StFirst a
StFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => FilePath -> StringTemplate a
newSTMP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e a. Exception e => IO a -> (e -> IO a) -> IO a
CE.catch
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\IOException
e -> FilePath
"IO Error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (IOException -> Maybe FilePath
ioeGetFileName IOException
e) forall a. [a] -> [a] -> [a]
++ FilePath
" -- " forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
ioeGetErrorString IOException
e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readFileUTF forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
path FilePath -> FilePath -> FilePath
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++FilePath
".st")
extraTmpls :: STGroup a
extraTmpls = forall a. STGroup a -> STGroup a -> STGroup a
addSubGroup (forall a. [(FilePath, StringTemplate a)] -> STGroup a
groupStringTemplates [(FilePath
"dumpAttribs", forall a. Stringable a => StringTemplate a
dumpAttribs)]) forall a. Stringable a => STGroup a
nullGroup
delayTime :: Double
delayTime :: Double
delayTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
cacheSTGroup :: STGroup a -> STGroup a
cacheSTGroup :: forall a. STGroup a -> STGroup a
cacheSTGroup STGroup a
g = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
!IORef (Map FilePath (UTCTime, StFirst (StringTemplate a)))
ior <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
M.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \FilePath
s -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Map FilePath (UTCTime, StFirst (StringTemplate a))
mp <- forall a. IORef a -> IO a
readIORef IORef (Map FilePath (UTCTime, StFirst (StringTemplate a)))
ior
UTCTime
curtime <- IO UTCTime
getCurrentTime
let udReturn :: UTCTime -> IO (StFirst (StringTemplate a))
udReturn UTCTime
now = do
let st :: StFirst (StringTemplate a)
st = STGroup a
g FilePath
s
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Map FilePath (UTCTime, StFirst (StringTemplate a)))
ior forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) () forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
s (UTCTime
now, StFirst (StringTemplate a)
st)
forall (m :: * -> *) a. Monad m => a -> m a
return StFirst (StringTemplate a)
st
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
s Map FilePath (UTCTime, StFirst (StringTemplate a))
mp of
Maybe (UTCTime, StFirst (StringTemplate a))
Nothing -> UTCTime -> IO (StFirst (StringTemplate a))
udReturn UTCTime
curtime
Just (UTCTime
t, StFirst (StringTemplate a)
st) ->
if (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$
UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
curtime UTCTime
t) forall a. Ord a => a -> a -> Bool
> Double
delayTime
then UTCTime -> IO (StFirst (StringTemplate a))
udReturn UTCTime
curtime
else forall (m :: * -> *) a. Monad m => a -> m a
return StFirst (StringTemplate a)
st