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