module Web.Scotty.Hastache where
import Control.Arrow ((***))
import Control.Monad.State as State
import Data.IORef (newIORef, readIORef,
writeIORef)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty)
import Data.Text.Lazy (Text)
import Network.Wai (Application, Response)
import Network.Wai.Handler.Warp (Port)
import System.FilePath.Posix ((</>))
import Text.Hastache
import Text.Hastache.Context
import Web.Scotty.Trans as S
scottyH :: (ScottyError e) => Port -> ScottyH e () -> IO ()
scottyH p s = do
(runH, runActionToIO) <- mkHStateRunners defaultConfig
scottyT p runH runActionToIO s
scottyHOpts :: (ScottyError e) => Options -> ScottyH e () -> IO ()
scottyHOpts opts s = do
(runH, runActionToIO) <- mkHStateRunners defaultConfig
scottyOptsT opts runH runActionToIO s
type ScottyH e = ScottyT e HState
type ActionH e = ActionT e HState
type ScottyH' = ScottyH Text
type ActionH' = ActionH Text
scottyH' :: Port -> ScottyH' () -> IO ()
scottyH' = scottyH
scottyHOpts' :: Options -> ScottyH' () -> IO ()
scottyHOpts' = scottyHOpts
setHastacheConfig :: MuConfig IO -> ScottyH e ()
setHastacheConfig conf = do
(_, tmap) <- lift State.get
lift . State.put $ (conf, tmap)
modifyHastacheConfig :: (MuConfig IO -> MuConfig IO) -> ScottyH e ()
modifyHastacheConfig f = lift $ State.modify (f *** id)
setTemplatesDir :: FilePath -> ScottyH e ()
setTemplatesDir dir = do
lift $ State.modify $ \(conf :: MuConfig IO, tmap) ->
(conf { muTemplateFileDir = Just dir }, tmap)
setTemplateFileExt :: String -> ScottyH e ()
setTemplateFileExt ext = do
lift $ State.modify $ \(conf :: MuConfig IO, tmap) ->
(conf { muTemplateFileExt = Just ext }, tmap)
hastache :: ScottyError e => FilePath -> ActionH e ()
hastache tpl = do
((conf :: MuConfig IO), tmap) <- lift State.get
let cntx a = fromMaybe MuNothing (M.lookup a tmap)
let tplFile = fromMaybe "." (muTemplateFileDir conf)
</> tpl
++ fromMaybe "" (muTemplateFileExt conf)
res <- liftIO $ hastacheFile conf tplFile (mkStrContext cntx)
html res
setH :: ScottyError e => String -> MuType IO -> ActionH e ()
setH x y = do
(conf, tmap) <- lift State.get
lift . State.put $ (conf, M.insert x y tmap)
type HState = StateT (MuConfig IO, M.Map String (MuType IO)) IO
mkHStateRunners :: MuConfig IO -> IO (forall a. HState a -> IO a, HState Response -> IO Response)
mkHStateRunners conf = do
gstate <- newIORef undefined
let runH m = do
(r,(muconf,_)) <- runStateT m (conf, mempty)
writeIORef gstate muconf
return r
runActionToIO m = do
muconf <- readIORef gstate
evalStateT m (muconf, mempty)
return (runH, runActionToIO)
scottyHApp :: MuConfig IO -> ScottyH e () -> IO Application
scottyHApp conf defs = do
(runH, runActionToIO) <- mkHStateRunners conf
scottyAppT runH runActionToIO defs