{-|

This module defines a TemplateDirectory data structure for convenient
interaction with templates within web apps.

-}

module Heist.TemplateDirectory
    ( TemplateDirectory
    , newTemplateDirectory
    , newTemplateDirectory'

    , getDirectoryHS
    , getDirectoryCTS
    , reloadTemplateDirectory
    ) where

------------------------------------------------------------------------------
import           Control.Concurrent
import           Control.Monad
import           Control.Monad.Trans
import           Heist
import           Heist.Internal.Types
import           Heist.Splices.Cache


------------------------------------------------------------------------------
-- | Structure representing a template directory.
data TemplateDirectory n
    = TemplateDirectory
        FilePath
        (HeistConfig n)
        (MVar (HeistState n))
        (MVar CacheTagState)


------------------------------------------------------------------------------
-- | Creates and returns a new 'TemplateDirectory' wrapped in an Either for
-- error handling.
newTemplateDirectory
    :: MonadIO n
    => FilePath
    -> HeistConfig n
    -- namespaced tag.
    -> IO (Either [String] (TemplateDirectory n))
newTemplateDirectory :: FilePath
-> HeistConfig n -> IO (Either [FilePath] (TemplateDirectory n))
newTemplateDirectory FilePath
dir HeistConfig n
hc = do
    let sc :: SpliceConfig n
sc = (HeistConfig n -> SpliceConfig n
forall (m :: * -> *). HeistConfig m -> SpliceConfig m
_hcSpliceConfig HeistConfig n
hc) { _scTemplateLocations :: [TemplateLocation]
_scTemplateLocations = [FilePath -> TemplateLocation
loadTemplates FilePath
dir] }
    let hc' :: HeistConfig n
hc' = HeistConfig n
hc { _hcSpliceConfig :: SpliceConfig n
_hcSpliceConfig = SpliceConfig n
sc }
    Either [FilePath] (HeistState n, CacheTagState)
epair <- HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
forall (n :: * -> *).
MonadIO n =>
HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
initHeistWithCacheTag HeistConfig n
hc'
    case Either [FilePath] (HeistState n, CacheTagState)
epair of
      Left [FilePath]
es -> Either [FilePath] (TemplateDirectory n)
-> IO (Either [FilePath] (TemplateDirectory n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FilePath] (TemplateDirectory n)
 -> IO (Either [FilePath] (TemplateDirectory n)))
-> Either [FilePath] (TemplateDirectory n)
-> IO (Either [FilePath] (TemplateDirectory n))
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Either [FilePath] (TemplateDirectory n)
forall a b. a -> Either a b
Left [FilePath]
es
      Right (HeistState n
hs,CacheTagState
cts) -> do
        MVar (HeistState n)
tsMVar <- IO (MVar (HeistState n)) -> IO (MVar (HeistState n))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (HeistState n)) -> IO (MVar (HeistState n)))
-> IO (MVar (HeistState n)) -> IO (MVar (HeistState n))
forall a b. (a -> b) -> a -> b
$ HeistState n -> IO (MVar (HeistState n))
forall a. a -> IO (MVar a)
newMVar HeistState n
hs
        MVar CacheTagState
ctsMVar <- IO (MVar CacheTagState) -> IO (MVar CacheTagState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar CacheTagState) -> IO (MVar CacheTagState))
-> IO (MVar CacheTagState) -> IO (MVar CacheTagState)
forall a b. (a -> b) -> a -> b
$ CacheTagState -> IO (MVar CacheTagState)
forall a. a -> IO (MVar a)
newMVar CacheTagState
cts
        Either [FilePath] (TemplateDirectory n)
-> IO (Either [FilePath] (TemplateDirectory n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [FilePath] (TemplateDirectory n)
 -> IO (Either [FilePath] (TemplateDirectory n)))
-> Either [FilePath] (TemplateDirectory n)
-> IO (Either [FilePath] (TemplateDirectory n))
forall a b. (a -> b) -> a -> b
$ TemplateDirectory n -> Either [FilePath] (TemplateDirectory n)
forall a b. b -> Either a b
Right (TemplateDirectory n -> Either [FilePath] (TemplateDirectory n))
-> TemplateDirectory n -> Either [FilePath] (TemplateDirectory n)
forall a b. (a -> b) -> a -> b
$ FilePath
-> HeistConfig n
-> MVar (HeistState n)
-> MVar CacheTagState
-> TemplateDirectory n
forall (n :: * -> *).
FilePath
-> HeistConfig n
-> MVar (HeistState n)
-> MVar CacheTagState
-> TemplateDirectory n
TemplateDirectory FilePath
dir HeistConfig n
hc' MVar (HeistState n)
tsMVar MVar CacheTagState
ctsMVar


------------------------------------------------------------------------------
-- | Creates and returns a new 'TemplateDirectory', using the monad's fail
-- function on error.
newTemplateDirectory'
    :: MonadIO n
    => FilePath
    -> HeistConfig n
    -> IO (TemplateDirectory n)
newTemplateDirectory' :: FilePath -> HeistConfig n -> IO (TemplateDirectory n)
newTemplateDirectory' FilePath
dir HeistConfig n
hc = do
    Either [FilePath] (TemplateDirectory n)
res <- FilePath
-> HeistConfig n -> IO (Either [FilePath] (TemplateDirectory n))
forall (n :: * -> *).
MonadIO n =>
FilePath
-> HeistConfig n -> IO (Either [FilePath] (TemplateDirectory n))
newTemplateDirectory FilePath
dir HeistConfig n
hc
    ([FilePath] -> IO (TemplateDirectory n))
-> (TemplateDirectory n -> IO (TemplateDirectory n))
-> Either [FilePath] (TemplateDirectory n)
-> IO (TemplateDirectory n)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO (TemplateDirectory n)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (TemplateDirectory n))
-> ([FilePath] -> FilePath)
-> [FilePath]
-> IO (TemplateDirectory n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) TemplateDirectory n -> IO (TemplateDirectory n)
forall (m :: * -> *) a. Monad m => a -> m a
return Either [FilePath] (TemplateDirectory n)
res


------------------------------------------------------------------------------
-- | Gets the 'HeistState' from a TemplateDirectory.
getDirectoryHS :: (MonadIO n)
               => TemplateDirectory n
               -> IO (HeistState n)
getDirectoryHS :: TemplateDirectory n -> IO (HeistState n)
getDirectoryHS (TemplateDirectory FilePath
_ HeistConfig n
_ MVar (HeistState n)
tsMVar MVar CacheTagState
_) =
    IO (HeistState n) -> IO (HeistState n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HeistState n) -> IO (HeistState n))
-> IO (HeistState n) -> IO (HeistState n)
forall a b. (a -> b) -> a -> b
$ MVar (HeistState n) -> IO (HeistState n)
forall a. MVar a -> IO a
readMVar (MVar (HeistState n) -> IO (HeistState n))
-> MVar (HeistState n) -> IO (HeistState n)
forall a b. (a -> b) -> a -> b
$ MVar (HeistState n)
tsMVar


------------------------------------------------------------------------------
-- | Clears the TemplateDirectory's cache tag state.
getDirectoryCTS :: TemplateDirectory n -> IO CacheTagState
getDirectoryCTS :: TemplateDirectory n -> IO CacheTagState
getDirectoryCTS (TemplateDirectory FilePath
_ HeistConfig n
_ MVar (HeistState n)
_ MVar CacheTagState
ctsMVar) = MVar CacheTagState -> IO CacheTagState
forall a. MVar a -> IO a
readMVar MVar CacheTagState
ctsMVar


------------------------------------------------------------------------------
-- | Clears cached content and reloads templates from disk.
reloadTemplateDirectory :: (MonadIO n)
                        => TemplateDirectory n
                        -> IO (Either String ())
reloadTemplateDirectory :: TemplateDirectory n -> IO (Either FilePath ())
reloadTemplateDirectory (TemplateDirectory FilePath
p HeistConfig n
hc MVar (HeistState n)
tsMVar MVar CacheTagState
ctsMVar) = do
    let sc :: SpliceConfig n
sc = (HeistConfig n -> SpliceConfig n
forall (m :: * -> *). HeistConfig m -> SpliceConfig m
_hcSpliceConfig HeistConfig n
hc) { _scTemplateLocations :: [TemplateLocation]
_scTemplateLocations = [FilePath -> TemplateLocation
loadTemplates FilePath
p] }
    Either [FilePath] (HeistState n, CacheTagState)
ehs <- HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
forall (n :: * -> *).
MonadIO n =>
HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
initHeistWithCacheTag (HeistConfig n
hc { _hcSpliceConfig :: SpliceConfig n
_hcSpliceConfig = SpliceConfig n
sc })
    Either [FilePath] (HeistState n, CacheTagState)
-> ((HeistState n, CacheTagState) -> IO ())
-> IO (Either FilePath ())
forall (m :: * -> *) b c.
Monad m =>
Either [FilePath] b -> (b -> m c) -> m (Either FilePath c)
leftPass Either [FilePath] (HeistState n, CacheTagState)
ehs (((HeistState n, CacheTagState) -> IO ())
 -> IO (Either FilePath ()))
-> ((HeistState n, CacheTagState) -> IO ())
-> IO (Either FilePath ())
forall a b. (a -> b) -> a -> b
$ \(HeistState n
hs,CacheTagState
cts) -> do
        MVar (HeistState n) -> (HeistState n -> IO (HeistState n)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (HeistState n)
tsMVar (IO (HeistState n) -> HeistState n -> IO (HeistState n)
forall a b. a -> b -> a
const (IO (HeistState n) -> HeistState n -> IO (HeistState n))
-> IO (HeistState n) -> HeistState n -> IO (HeistState n)
forall a b. (a -> b) -> a -> b
$ HeistState n -> IO (HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return HeistState n
hs)
        MVar CacheTagState -> (CacheTagState -> IO CacheTagState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar CacheTagState
ctsMVar (IO CacheTagState -> CacheTagState -> IO CacheTagState
forall a b. a -> b -> a
const (IO CacheTagState -> CacheTagState -> IO CacheTagState)
-> IO CacheTagState -> CacheTagState -> IO CacheTagState
forall a b. (a -> b) -> a -> b
$ CacheTagState -> IO CacheTagState
forall (m :: * -> *) a. Monad m => a -> m a
return CacheTagState
cts)


------------------------------------------------------------------------------
-- | Prepends an error onto a Left.
leftPass :: Monad m => Either [String] b -> (b -> m c) -> m (Either String c)
leftPass :: Either [FilePath] b -> (b -> m c) -> m (Either FilePath c)
leftPass Either [FilePath] b
e b -> m c
m = ([FilePath] -> m (Either FilePath c))
-> (b -> m (Either FilePath c))
-> Either [FilePath] b
-> m (Either FilePath c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either FilePath c -> m (Either FilePath c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath c -> m (Either FilePath c))
-> ([FilePath] -> Either FilePath c)
-> [FilePath]
-> m (Either FilePath c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath c
forall a b. a -> Either a b
Left (FilePath -> Either FilePath c)
-> ([FilePath] -> FilePath) -> [FilePath] -> Either FilePath c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
loadError (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
                      ((c -> Either FilePath c) -> m c -> m (Either FilePath c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM c -> Either FilePath c
forall a b. b -> Either a b
Right (m c -> m (Either FilePath c))
-> (b -> m c) -> b -> m (Either FilePath c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m c
m) Either [FilePath] b
e
  where
    loadError :: FilePath -> FilePath
loadError = FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(++) (FilePath
"Error loading templates: " :: String)