{-# 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

{--------------------------------------------------------------------
  Utilities
--------------------------------------------------------------------}

(<$$>) :: (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 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
   FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
x Int -> IO FilePath -> IO FilePath
`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 FilePath -> IO FilePath
rf [(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  (\(FilePath
f,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 FilePath
ext FilePath
base 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] -> [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 (\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')
&&& (\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

{--------------------------------------------------------------------
  Group API
--------------------------------------------------------------------}

-- | Given a list of named of StringTemplates, returns a group which generates
-- them such that they can call one another.
groupStringTemplates :: [(String,StringTemplate a)] -> STGroup a
groupStringTemplates :: [(FilePath, StringTemplate a)] -> STGroup a
groupStringTemplates [(FilePath, StringTemplate a)]
xs = STGroup a
newGen
    where newGen :: STGroup a
newGen 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

-- | Given a path, returns a group which generates all files in said directory
-- which have the proper \"st\" extension.
-- This function is strict, with all files read once. As it performs file IO,
-- expect it to throw the usual exceptions.
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 FilePath
".st"

-- | 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 :: FilePath -> FilePath -> IO (STGroup a)
directoryGroupExt FilePath
ext 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
readFileStrictly ([(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

-- | Given a path, returns a group which generates all files in said directory
-- which have the proper \"st\" extension.
-- This function is lazy in the same way that readFile is lazy, with all
-- files read on demand, but no more than once. The list of files, however,
-- is generated at the time the function is called. As this performs file IO,
-- expect it to throw the usual exceptions. And, as it is lazy, expect
-- these exceptions in unexpected places.
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 FilePath
".st"

-- | Given a path, returns a group which generates all files in said directory which have the supplied extension.
directoryGroupLazyExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupLazyExt :: FilePath -> FilePath -> IO (STGroup a)
directoryGroupLazyExt FilePath
ext 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

-- | As with 'directoryGroup', but traverses subdirectories as well. A template named
-- \"foo\/bar.st\" may be referenced by \"foo\/bar\" in the returned group.
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 FilePath
".st"

-- | As with 'directoryGroupRecursive', but a template extension is supplied.
directoryGroupRecursiveExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveExt :: FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveExt FilePath
ext 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
readFileStrictly ([(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
"" FilePath
path

-- | See documentation for 'directoryGroupRecursive'.
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 FilePath
".st"

-- | As with 'directoryGroupRecursiveLazy', but a template extension is supplied.
directoryGroupRecursiveLazyExt :: (Stringable a) => FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveLazyExt :: FilePath -> FilePath -> IO (STGroup a)
directoryGroupRecursiveLazyExt FilePath
ext 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
"" FilePath
path

-- | Adds a supergroup to any StringTemplate group such that templates from
-- the original group are now able to call ones from the supergroup as well.
addSuperGroup :: STGroup a -> STGroup a -> STGroup a
addSuperGroup :: STGroup a -> STGroup a -> STGroup a
addSuperGroup STGroup a
f 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

-- | Adds a \"subgroup\" to any StringTemplate group such that templates from
-- the original group now have template calls \"shadowed\" by the subgroup.
addSubGroup :: STGroup a -> STGroup a -> STGroup a
addSubGroup :: STGroup a -> STGroup a -> STGroup a
addSubGroup STGroup a
f 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

-- | Merges two groups into a single group. This function is left-biased,
-- prefering bindings from the first group when there is a conflict.
mergeSTGroups :: STGroup a -> STGroup a -> STGroup a
mergeSTGroups :: STGroup a -> STGroup a -> STGroup a
mergeSTGroups STGroup a
f 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

-- | Adds a set of global options to a group
optInsertGroup :: [(String, String)] -> STGroup a -> STGroup a
optInsertGroup :: [(FilePath, FilePath)] -> STGroup a -> STGroup a
optInsertGroup [(FilePath, FilePath)]
opts 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

-- | Sets an encoding function of a group that all values are
-- rendered with in each enclosed template
setEncoderGroup :: (Stringable a) => (a -> a) ->  STGroup a -> STGroup a
setEncoderGroup :: (a -> a) -> STGroup a -> STGroup a
setEncoderGroup a -> a
x 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

-- | For any requested template, returns a message that the template was
-- unable to be found. Useful to add as a super group for a set of templates
-- under development, to aid in debugging.
nullGroup :: Stringable a => STGroup a
nullGroup :: STGroup a
nullGroup 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
$ FilePath
"Could not find template: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x

-- | Given an integral amount of seconds and a path, returns a group generating
-- all files in said directory and subdirectories with the proper \"st\" extension,
-- cached for that amount of seconds. IO errors are \"swallowed\" by this so
-- that exceptions don't arise in unexpected places.
-- This violates referential transparency, but can be very useful in developing
-- templates for any sort of server application. It should be swapped out for
-- production purposes. The dumpAttribs template is added to the returned group
-- by default, as it should prove useful for debugging and developing templates.
unsafeVolatileDirectoryGroup :: Stringable a => FilePath -> Int -> IO (STGroup a)
unsafeVolatileDirectoryGroup :: FilePath -> Int -> IO (STGroup a)
unsafeVolatileDirectoryGroup FilePath
path 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
. (\IOError
e -> FilePath
"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 -> 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]
++FilePath
".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 [(FilePath
"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 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
$ \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 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
                                 Maybe (UTCTime, StFirst (StringTemplate a))
Nothing -> UTCTime -> IO (StFirst (StringTemplate a))
udReturn UTCTime
curtime
                                 Just (UTCTime
t, 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