This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "heist".
The branch, master has been updated
via a876debdaee603049410ec39db282b62cdc2ad02 (commit)
via 0e12582de42ea10bc5627be094975db7a161a822 (commit)
via 6103ba9f4ca551689078ec3bb16c8bf47e6fbbf5 (commit)
via 2517ee583258311087f347e7ea02ef8247cca18f (commit)
via e3727beb64f83eaa441fadda61651318f394c0cf (commit)
from 9fecf4492a92abeb5a6c4f7c21e563fd176e9cc8 (commit)
Summary of changes:
src/Text/Templating/Heist.hs | 1 +
src/Text/Templating/Heist/Internal.hs | 16 ++++++++++++----
src/Text/Templating/Heist/TemplateDirectory.hs | 1 -
3 files changed, 13 insertions(+), 5 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a876debdaee603049410ec39db282b62cdc2ad02
Author: Shane <[email protected]>
Date: Thu Jul 15 15:21:02 2010 +0100
Added 'bindString', the singular of 'bindStrings'.
diff --git a/src/Text/Templating/Heist.hs b/src/Text/Templating/Heist.hs
index 8c0fbb3..cca3274 100644
--- a/src/Text/Templating/Heist.hs
+++ b/src/Text/Templating/Heist.hs
@@ -103,6 +103,7 @@ module Text.Templating.Heist
, callTemplate
, renderTemplate
, bindStrings
+ , bindString
-- * Misc functions
, getDoc
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index 34296c1..45b7a92 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -392,14 +392,22 @@ evalWithHooks name = lookupAndRun name
------------------------------------------------------------------------------
--- | Binds a list of constant string splices
+-- | Binds a list of constant string splices.
bindStrings :: Monad m
=> [(ByteString, ByteString)]
-> TemplateState m
-> TemplateState m
-bindStrings pairs ts = foldr add ts pairs
- where
- add (n,v) = bindSplice n (return [X.Text v])
+bindStrings pairs ts = foldr (uncurry bindString) ts pairs
+
+
+------------------------------------------------------------------------------
+-- | Binds a single constant string splice.
+bindString :: Monad m
+ => ByteString
+ -> ByteString
+ -> TemplateState m
+ -> TemplateState m
+bindString n v = bindSplice n $ return [X.Text v]
------------------------------------------------------------------------------
diff --git a/src/Text/Templating/Heist/TemplateDirectory.hs
b/src/Text/Templating/Heist/TemplateDirectory.hs
index 78b7b52..b46c15d 100644
--- a/src/Text/Templating/Heist/TemplateDirectory.hs
+++ b/src/Text/Templating/Heist/TemplateDirectory.hs
@@ -18,7 +18,6 @@ module Text.Templating.Heist.TemplateDirectory
import Control.Concurrent
import Control.Monad
import Control.Monad.Trans
-import Data.ByteString.Char8 (ByteString)
import Text.Templating.Heist
import Text.Templating.Heist.Splices.Static
commit 0e12582de42ea10bc5627be094975db7a161a822
Author: Shane <[email protected]>
Date: Thu Jul 15 15:15:02 2010 +0100
Revert "Removed TemplateDirectory and replaced it with HeistT which
provides similar functionality."
This reverts commit e3727beb64f83eaa441fadda61651318f394c0cf.
diff --git a/heist.cabal b/heist.cabal
index 009aa3d..a4f53b4 100644
--- a/heist.cabal
+++ b/heist.cabal
@@ -1,5 +1,5 @@
name: heist
-version: 0.3.0
+version: 0.2.3
synopsis: An xhtml templating system
license: BSD3
license-file: LICENSE
@@ -80,7 +80,7 @@ Library
Text.Templating.Heist.Splices.Ignore,
Text.Templating.Heist.Splices.Markdown,
Text.Templating.Heist.Splices.Static,
- Text.Templating.Heist.Monad
+ Text.Templating.Heist.TemplateDirectory
other-modules:
Text.Templating.Heist.Internal,
@@ -95,7 +95,7 @@ Library
directory,
directory-tree,
filepath,
- hexpat >= 0.16 && <= 0.17,
+ hexpat >= 0.16 && <0.17,
MonadCatchIO-transformers >= 0.2.1 && < 0.3,
monads-fd,
process,
diff --git a/src/Text/Templating/Heist/Monad.hs
b/src/Text/Templating/Heist/Monad.hs
deleted file mode 100644
index cdef512..0000000
--- a/src/Text/Templating/Heist/Monad.hs
+++ /dev/null
@@ -1,246 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-{-|
-
-This module exports the 'HeistT' monad transformer and the related
-'MonadHeist' type class. 'MonadHeist' instances are defined any 'Monad'
-transformed by 'HeistT', as well as passthroughs for any 'MonadHeist' wrapped
-around one of the common monad transformers.
-
--}
-
-module Text.Templating.Heist.Monad
- ( MonadHeist(..)
- , HeistT
- , runHeistT'
- , runHeistT
- ) where
-
-import Control.Concurrent
-import Control.Monad
-import Control.Monad.Cont
-import Control.Monad.Error
-import Control.Monad.List
-import Control.Monad.RWS.Strict hiding (pass)
-import qualified Control.Monad.RWS.Lazy as LRWS
-import Control.Monad.Reader
-import Control.Monad.State.Strict
-import qualified Control.Monad.State.Lazy as LState
-import Control.Monad.Writer.Strict hiding (pass)
-import qualified Control.Monad.Writer.Lazy as LWriter
-import Data.ByteString(ByteString)
-import Text.Templating.Heist
-import Text.Templating.Heist.Splices.Static
-
-
-------------------------------------------------------------------------------
--- | The 'MonadHeist' typeclass. A 'MonadHeist' is kind of like a 'Reader'
--- with a 'TemplateState' as its environment, but it also supports the
--- additional operations of rendering and reloading.
-class (Monad m, Monad n) => MonadHeist m n | n -> m where
- -- | Retrieves the 'TemplateState'.
- heistState :: n (TemplateState m)
-
- -- | Runs an action with a modified 'TemplateState'. You might want to use
- -- this if you had a set of splices which were customised for a specific
- -- action. To do that you would do:
- --
- -- > heistLocal (bindSplices mySplices)
- heistLocal :: (TemplateState m -> TemplateState m) -> n a -> n a
-
- -- | Attempts to retrieve the template with the given name from the
- -- environment and render it with the splices currently in the
- -- environment. 'Nothing' is returned if the template with that name was
- -- not found.
- heistRender :: ByteString -> n (Maybe ByteString)
-
- -- | Attempts to clear the 'StaticTagState' and reload the templates from
- -- disk. If it fails to do that, an error message is returned in the
- -- 'Left' of the 'Either'.
- heistReload :: n (Either String ())
-
-
-------------------------------------------------------------------------------
--- | HeistState is the internal state of any 'MonadHeist'. 'HeistT' is just a
--- 'ReaderT' with a 'HeistState' as its environment. It stores the
--- 'TemplateState' and the 'StaticTagState' and enough additional information
--- to support the 'heistReload' operation which flushes the 'StaticTagState'
--- and reloads all the templates in the 'TemplateState' from disk.
-data HeistState m = HeistState
- { _path :: FilePath
- , _origTs :: TemplateState m
- , _tsMVar :: MVar (TemplateState m)
- , _sts :: StaticTagState
- , _modifier :: TemplateState m -> TemplateState m
- }
-
-
-------------------------------------------------------------------------------
--- | The 'HeistT' monad transformer.
---
--- This is defined with a simple type alias instead of the more common idiom
--- of using a @newtype@ combined with the @GeneralizedNewtypeDeriving@
--- extension to automatically derive all the required instances. The problem
--- with that it required the programmer to specify every monad typeclass which
--- needs to be derived in the @deriving@ clause, but in this case the
--- programmer can't know which monad typeclasses are required. If a user makes
--- a @Foo@ monad, with an associated @MonadFoo@ typeclass with passthrough
--- instances for all the common transformers, then @HeistT Foo@ wouldn't be a
--- @MonadFoo@, because @HeistT@ is not likely to have a passthrough instance
--- for @MonadFoo@ (it certainly wouldn't if it was defined in a library which
--- knew nothing about Heist). However, if we use a simple type alias, then
--- 'HeistT' is really just a 'ReaderT', which /does/ have passthrough
--- instances for most monad typeclasses in the wild.
---
--- However, it is requested that users do not rely on the 'MonadReader'
--- instance provided by 'HeistT', as this is simply an implementation detail
--- that may change at any time.
-type HeistT m a = ReaderT (HeistState m) m a
-
-
-------------------------------------------------------------------------------
--- | Runs a 'HeistT' computation. It returns an 'Either', representing failure
--- (e.g., the given directory did not exist) with a 'Left' and otherwise
--- returning a 'Right'. It is in the 'IO' monad and not 'm' because if loading
--- the templates is going to fail, it is desirable to have that happen outside
--- of 'm', and so we only put a value in 'm' on success.
-runHeistT' :: MonadIO m
- => HeistT m a
- -> FilePath
- -- ^ The 'HeistT' computation.
- -> TemplateState m
- -- ^ The directory containing the templates.
- -> IO (Either String (m a))
- -- ^ The initial template state (might be 'emptyTemplateState' with
- -- the addition of some global splices).
-runHeistT' m path origTs = do
- (staticTs,sts) <- bindStaticTag origTs
- ets <- loadTemplates path staticTs
- leftPass ets $ \ts -> do
- tsMVar <- newMVar ts
- return $ runReaderT m $ HeistState path origTs tsMVar sts id
-
-
-------------------------------------------------------------------------------
--- | A variant of 'runHeistT'' which calls 'fail' directly if it encounters
--- an error loading the templates, as opposed to wrapping the error in an
--- 'Either'.
-runHeistT :: MonadIO m
- => HeistT m a
- -> FilePath
- -- ^ The 'HeistT' computation.
- -> TemplateState m
- -- ^ The directory containing the templates.
- -> IO (m a)
- -- ^ The initial template state (might be 'emptyTemplateState' with
- -- the addition of some global splices).
-runHeistT m path origTs = either fail return =<< runHeistT' m path origTs
-
-
-------------------------------------------------------------------------------
-instance MonadIO m => MonadHeist m (ReaderT (HeistState m) m) where
- heistState = do
- (HeistState _ _ tsMVar _ modifier) <- ask
- return . modifier =<< (liftIO $ readMVar tsMVar)
-
- heistLocal f = local $ \s -> s { _modifier = f . (_modifier s) }
-
- heistRender s = heistState >>= \m -> lift $ renderTemplate m s
-
- heistReload = do
- (HeistState path origTs tsMVar sts _) <- ask
- liftIO $ do
- clearStaticTagCache $ sts
- ets <- loadTemplates path origTs
- leftPass ets $ modifyMVar_ tsMVar . const . return
-
-
-------------------------------------------------------------------------------
--- | A utility function that prepends an error onto a Left.
-leftPass :: Monad m => Either String b -> (b -> m c) -> m (Either String c)
-leftPass e m = either (return . Left . loadError) (liftM Right . m) e
- where
- loadError = (++) "Error loading templates: "
-
-
-------------------------------------------------------------------------------
-instance MonadHeist m n => MonadHeist m (ContT c n) where
- heistState = lift heistState
- heistLocal f m = ContT $ \c -> heistLocal f $ runContT m c
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance (MonadHeist m n, Error e) => MonadHeist m (ErrorT e n) where
- heistState = lift heistState
- heistLocal f m = ErrorT $ heistLocal f $ runErrorT m
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance MonadHeist m n => MonadHeist m (ListT n) where
- heistState = lift heistState
- heistLocal f m = ListT $ heistLocal f $ runListT m
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance (MonadHeist m n, Monoid w) => MonadHeist m (RWST r w s n) where
- heistState = lift heistState
- heistLocal f m = RWST $ \r s -> heistLocal f $ runRWST m r s
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance (MonadHeist m n, Monoid w) => MonadHeist m (LRWS.RWST r w s n) where
- heistState = lift heistState
- heistLocal f m = LRWS.RWST $ \r s -> heistLocal f $ LRWS.runRWST m r s
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance MonadHeist m n => MonadHeist m (ReaderT r n) where
- heistState = lift heistState
- heistLocal f m = ReaderT $ \r -> heistLocal f $ runReaderT m r
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance MonadHeist m n => MonadHeist m (StateT s n) where
- heistState = lift heistState
- heistLocal f m = StateT $ \s -> heistLocal f $ runStateT m s
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance MonadHeist m n => MonadHeist m (LState.StateT s n) where
- heistState = lift heistState
- heistLocal f m = LState.StateT $ \s -> heistLocal f $ LState.runStateT m s
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance (MonadHeist m n, Monoid w) => MonadHeist m (WriterT w n) where
- heistState = lift heistState
- heistLocal f m = WriterT $ heistLocal f $ runWriterT m
- heistRender = lift . heistRender
- heistReload = lift heistReload
-
-
-------------------------------------------------------------------------------
-instance (MonadHeist m n, Monoid w) => MonadHeist m (LWriter.WriterT w n) where
- heistState = lift heistState
- heistLocal f m = LWriter.WriterT $ heistLocal f $ LWriter.runWriterT m
- heistRender = lift . heistRender
- heistReload = lift heistReload
diff --git a/src/Text/Templating/Heist/TemplateDirectory.hs
b/src/Text/Templating/Heist/TemplateDirectory.hs
new file mode 100644
index 0000000..78b7b52
--- /dev/null
+++ b/src/Text/Templating/Heist/TemplateDirectory.hs
@@ -0,0 +1,85 @@
+{-|
+
+This module defines a TemplateDirectory data structure for convenient
+interaction with templates within web apps.
+
+-}
+
+module Text.Templating.Heist.TemplateDirectory
+ ( TemplateDirectory
+ , newTemplateDirectory
+ , newTemplateDirectory'
+
+ , getDirectoryTS
+ , reloadTemplateDirectory
+ ) where
+
+------------------------------------------------------------------------------
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.Trans
+import Data.ByteString.Char8 (ByteString)
+import Text.Templating.Heist
+import Text.Templating.Heist.Splices.Static
+
+
+------------------------------------------------------------------------------
+-- | Structure representing a template directory.
+data TemplateDirectory m
+ = TemplateDirectory
+ FilePath
+ (TemplateState m)
+ (MVar (TemplateState m))
+ StaticTagState
+
+
+------------------------------------------------------------------------------
+-- | Creates and returns a new 'TemplateDirectory' wrapped in an Either for
+-- error handling.
+newTemplateDirectory :: (MonadIO m, MonadIO n)
+ => FilePath
+ -> TemplateState m
+ -> n (Either String (TemplateDirectory m))
+newTemplateDirectory dir templateState = liftIO $ do
+ (origTs,sts) <- bindStaticTag templateState
+ ets <- loadTemplates dir origTs
+ leftPass ets $ \ts -> do
+ tsMVar <- newMVar $ ts
+ return $ TemplateDirectory dir origTs tsMVar sts
+
+
+------------------------------------------------------------------------------
+-- | Creates and returns a new 'TemplateDirectory', using the monad's fail
+-- function on error.
+newTemplateDirectory' :: (MonadIO m, MonadIO n)
+ => FilePath
+ -> TemplateState m
+ -> n (TemplateDirectory m)
+newTemplateDirectory' = ((either fail return =<<) .) . newTemplateDirectory
+
+
+------------------------------------------------------------------------------
+-- | Gets the 'TemplateState' from a TemplateDirectory.
+getDirectoryTS :: (Monad m, MonadIO n)
+ => TemplateDirectory m
+ -> n (TemplateState m)
+getDirectoryTS (TemplateDirectory _ _ tsMVar _) = liftIO $ readMVar $ tsMVar
+
+
+------------------------------------------------------------------------------
+-- | Clears cached content and reloads templates from disk.
+reloadTemplateDirectory :: (MonadIO m, MonadIO n)
+ => TemplateDirectory m
+ -> n (Either String ())
+reloadTemplateDirectory (TemplateDirectory p origTs tsMVar sts) = liftIO $ do
+ clearStaticTagCache sts
+ ets <- loadTemplates p origTs
+ leftPass ets $ \ts -> modifyMVar_ tsMVar (const $ return ts)
+
+
+------------------------------------------------------------------------------
+-- | Prepends an error onto a Left.
+leftPass :: Monad m => Either String b -> (b -> m c) -> m (Either String c)
+leftPass e m = either (return . Left . loadError) (liftM Right . m) e
+ where
+ loadError = (++) "Error loading templates: "
-----------------------------------------------------------------------
hooks/post-receive
--
heist
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
