    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE NoMonomorphismRestriction  #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FunctionalDependencies     #-}
    {-# LANGUAGE TypeSynonymInstances       #-}

    {-|

    This module implements the Heist snaplet without using type classes.  It is
    provided mainly as an example of how snaplets can be written with and without
    a type class for convenience.

    -}
    module Snap.Snaplet.HeistNoClass
      ( Heist
      , DefaultMode(..)
      , heistInit
      , heistInit'
      , heistReloader
      , setInterpreted
      , getCurHeistConfig
      , clearHeistCache

      , addTemplates
      , addTemplatesAt
      , getHeistState
      , modifyHeistState
      , modifyHeistState'
      , withHeistState
      , withHeistState'

      , gRender
      , gRenderAs
      , gHeistServe
      , gHeistServeSingle
      , chooseMode

      , addConfig
      , cRender
      , cRenderAs
      , cHeistServe
      , cHeistServeSingle

      , render
      , renderAs
      , heistServe
      , heistServeSingle
      , heistLocal
      , withSplices
      , renderWithSplices
      , heistLocal'
      , withSplices'
      , renderWithSplices'

      , SnapletHeist
      , SnapletISplice
      , SnapletCSplice
      ) where

    import           Prelude hiding ((.), id)
    import           Control.Applicative
    import           Control.Category
    import           Control.Lens
    import           Control.Monad.Reader
    import           Control.Monad.State
    import           Control.Monad.Trans.Either
    import           Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as B
    import           Data.DList (DList)
    import qualified Data.HashMap.Strict as Map
    import           Data.IORef
    import           Data.Maybe
    import           Data.Monoid
    import qualified Data.Text as T
    import           Data.Text.Encoding
    import           System.FilePath.Posix
    import           Heist
    import qualified Heist.Compiled as C
    import qualified Heist.Interpreted as I
    import           Heist.Splices.Cache

    import           Snap.Snaplet
    import           Snap.Snaplet.Heist.Internal
    import           Snap.Core
    import           Snap.Util.FileServe

    ------------------------------------------------------------------------------
    changeState :: (HeistState (Handler a a) -> HeistState (Handler a a))
                -> Heist a
                -> Heist a
    changeState _ (Configuring _)  =
        error "changeState: HeistState has not been initialized"
    changeState f (Running hc hs cts dm) = Running hc (f hs) cts dm

    ------------------------------------------------------------------------------
    -- | Clears data stored by the cache tag.  The cache tag automatically reloads
    -- its data when the specified TTL expires, but sometimes you may want to
    -- trigger a manual reload.  This function lets you do that.
    clearHeistCache :: Heist b -> IO ()
    clearHeistCache = clearCacheTagState . _heistCTS

                             -----------------------------
                             -- SnapletSplice functions --
                             -----------------------------

    ------------------------------------------------------------------------------
    -- | This instance is here because we don't want the heist package to depend
    -- on anything from snap packages.
    instance MonadSnap m => MonadSnap (HeistT n m) where
        liftSnap = lift . liftSnap

    type SnapletHeist b m a = HeistT (Handler b b) m a
    type SnapletCSplice b = SnapletHeist b IO (DList (Chunk (Handler b b)))
    type SnapletISplice b = SnapletHeist b (Handler b b) Template

                              ---------------------------
                              -- Initializer functions --
                              ---------------------------

    ------------------------------------------------------------------------------
    -- | The 'Initializer' for 'Heist'. This function is a convenience wrapper
    -- around `heistInit'` that uses defaultHeistState and sets up routes for all
    -- the templates.  It sets up a \"heistReload\" route that reloads the heist
    -- templates when you request it from localhost.
    heistInit :: FilePath
                  -- ^ Path to templates
              -> SnapletInit b (Heist b)
    heistInit = gHeistInit heistServe

    ------------------------------------------------------------------------------
    -- | A lower level 'Initializer' for 'Heist'.  This initializer requires you
    -- to specify the initial HeistConfig.  It also does not add any routes for
    -- templates, allowing you complete control over which templates get routed.
    heistInit' :: FilePath
                   -- ^ Path to templates
               -> HeistConfig (Handler b b)
                   -- ^ Initial HeistConfig
               -> SnapletInit b (Heist b)
    heistInit' templateDir initialConfig =
        makeSnaplet "heist" "" Nothing $ heistInitWorker templateDir initialConfig

    ------------------------------------------------------------------------------
    -- | Sets the snaplet to default to interpreted mode.  Initially, the
    -- initializer sets the value to compiled mode.  This function allows you to
    -- override that setting.  Note that this is just a default.  It only has an
    -- effect if you use one of the generic functions: 'gRender', 'gRenderAs',
    -- 'gHeistServe', or 'gHeistServeSingle'.  If you call the non-generic
    -- versions directly, then this value will not be checked and you will get the
    -- mode implemented by the function you called.
    setInterpreted :: Snaplet (Heist b) -> Initializer b v ()
    setInterpreted h =
        liftIO $ atomicModifyIORef (_heistConfig $ view snapletValue h)
            (\(hc,_) -> ((hc,Interpreted),()))

    ------------------------------------------------------------------------------
    -- | Adds templates to the Heist HeistConfig.  Other snaplets should use
    -- this function to add their own templates.  The templates are automatically
    -- read from the templates directory in the current snaplet's filesystem root.
    addTemplates :: Snaplet (Heist b)
                 -> ByteString
                     -- ^ The url prefix for the template routes
                 -> Initializer b (Heist b) ()
    addTemplates h urlPrefix = do
        snapletPath <- getSnapletFilePath
        addTemplatesAt h urlPrefix (snapletPath </> "templates")

    ------------------------------------------------------------------------------
    -- | Adds templates to the Heist HeistConfig, and lets you specify where
    -- they are found in the filesystem.  Note that the path to the template
    -- directory is an absolute path.  This allows you more flexibility in where
    -- your templates are located, but means that you have to explicitly call
    -- getSnapletFilePath if you want your snaplet to use templates within its
    -- normal directory structure.
    addTemplatesAt :: Snaplet (Heist b)
                   -> ByteString
                       -- ^ URL prefix for template routes
                   -> FilePath
                       -- ^ Path to templates
                   -> Initializer b (Heist b) ()
    addTemplatesAt h urlPrefix templateDir = do
        rootUrl <- getSnapletRootURL
        let fullPrefix = (T.unpack $ decodeUtf8 rootUrl) </>
                         (T.unpack $ decodeUtf8 urlPrefix)
            addPrefix = addTemplatePathPrefix
                          (encodeUtf8 $ T.pack fullPrefix)
        ts <- liftIO $ runEitherT (loadTemplates templateDir) >>=
                       either (error . concat) return
        printInfo $ T.pack $ unwords
            [ "...adding"
            , (show $ Map.size ts)
            , "templates from"
            , templateDir
            , "with route prefix"
            , fullPrefix ++ "/"
            ]
        let locations = [liftM addPrefix $ loadTemplates templateDir]
            add (hc, dm) =
              ((over hcTemplateLocations (mappend locations) hc, dm), ())
        liftIO $ atomicModifyIORef (_heistConfig $ view snapletValue h) add

    getCurHeistConfig :: Snaplet (Heist b)
                      -> Initializer b v (HeistConfig (Handler b b))
    getCurHeistConfig h = case view snapletValue h of
        Configuring ref -> do
            (hc, _) <- liftIO $ readIORef ref
            return hc
        Running _ _ _ _ ->
            error "Can't get HeistConfig after heist is initialized."

    ------------------------------------------------------------------------------
    getHeistState :: SnapletLens (Snaplet b) (Heist b)
                  -> Handler b v (HeistState (Handler b b))
    getHeistState heist = withTop' heist $ gets _heistState

    ------------------------------------------------------------------------------
    modifyHeistState' :: SnapletLens (Snaplet b) (Heist b)
                      -> (HeistState (Handler b b) -> HeistState (Handler b b))
                      -> Initializer b v ()
    modifyHeistState' heist f = do
        withTop' heist $ addPostInitHook $ return . changeState f

    ------------------------------------------------------------------------------
    modifyHeistState :: SnapletLens b (Heist b)
                     -> (HeistState (Handler b b) -> HeistState (Handler b b))
                     -> Initializer b v ()
    modifyHeistState heist f = modifyHeistState' (subSnaplet heist) f

    ------------------------------------------------------------------------------
    withHeistState' :: SnapletLens (Snaplet b) (Heist b)
                    -> (HeistState (Handler b b) -> a)
                    -> Handler b v a
    withHeistState' heist f = do
        hs <- withTop' heist $ gets _heistState
        return $ f hs

    ------------------------------------------------------------------------------
    withHeistState :: SnapletLens b (Heist b)
                   -> (HeistState (Handler b b) -> a)
                   -> Handler b v a
    withHeistState heist f = withHeistState' (subSnaplet heist) f

    ------------------------------------------------------------------------------
    -- | Adds more HeistConfig data using mappend with whatever is currently
    -- there.  This is the preferred method for adding all four kinds of splices
    -- as well as new templates.
    addConfig :: Snaplet (Heist b)
              -> SpliceConfig (Handler b b)
              -> Initializer b v ()
    addConfig h sc = case view snapletValue h of
        Configuring ref ->
            liftIO $ atomicModifyIORef ref add
        Running _ _ _ _ -> do
            printInfo "finalLoadHook called while running"
            error "this shouldn't happen"
      where
        add (hc, dm) =
          ((over hcSpliceConfig (`mappend` sc) hc, dm), ())

                                -----------------------
                                -- Handler functions --
                                -----------------------

    ------------------------------------------------------------------------------
    -- | Internal helper function for rendering.
    iRenderHelper :: Maybe MIMEType
                 -> ByteString
                 -> Handler b (Heist b) ()
    iRenderHelper c t = do
        (Running _ hs _ _) <- get
        withTop' id $ I.renderTemplate hs t >>= maybe pass serve
      where
        serve (b, mime) = do
            modifyResponse $ setContentType $ fromMaybe mime c
            writeBuilder b

    ------------------------------------------------------------------------------
    -- | Internal helper function for rendering.
    cRenderHelper :: Maybe MIMEType
                  -> ByteString
                  -> Handler b (Heist b) ()
    cRenderHelper c t = do
        (Running _ hs _ _) <- get
        withTop' id $ maybe pass serve $ C.renderTemplate hs t
      where
        serve (b, mime) = do
            modifyResponse $ setContentType $ fromMaybe mime c
            writeBuilder =<< b

    ------------------------------------------------------------------------------
    serveURI :: Handler b (Heist b) ByteString
    serveURI = do
        p <- getSafePath
        -- Allows users to prefix template filenames with an underscore to prevent
        -- the template from being served.
        if take 1 p == "_" then pass else return $ B.pack p

    ------------------------------------------------------------------------------
    render :: ByteString
               -- ^ Name of the template
           -> Handler b (Heist b) ()
    render t = iRenderHelper Nothing t

    ------------------------------------------------------------------------------
    renderAs :: ByteString
                 -- ^ Content type
             -> ByteString
                 -- ^ Name of the template
             -> Handler b (Heist b) ()
    renderAs ct t = iRenderHelper (Just ct) t

    ------------------------------------------------------------------------------
    heistServe :: Handler b (Heist b) ()
    heistServe =
        ifTop (render "index") <|> (render =<< serveURI)

    ------------------------------------------------------------------------------
    heistServeSingle :: ByteString -> Handler b (Heist b) ()
    heistServeSingle t =
        render t <|> error ("Template " ++ show t ++ " not found.")

    ------------------------------------------------------------------------------
    cRender :: ByteString
               -- ^ Name of the template
            -> Handler b (Heist b) ()
    cRender t = cRenderHelper Nothing t

    ------------------------------------------------------------------------------
    cRenderAs :: ByteString
                 -- ^ Content type
              -> ByteString
                 -- ^ Name of the template
              -> Handler b (Heist b) ()
    cRenderAs ct t = cRenderHelper (Just ct) t

    ------------------------------------------------------------------------------
    cHeistServe :: Handler b (Heist b) ()
    cHeistServe =
        ifTop (cRender "index") <|> (cRender =<< serveURI)

    ------------------------------------------------------------------------------
    cHeistServeSingle :: ByteString -> Handler b (Heist b) ()
    cHeistServeSingle t =
        cRender t <|> error ("Template " ++ show t ++ " not found.")

    ------------------------------------------------------------------------------
    -- | Chooses between a compiled action and an interpreted action based on the
    -- configured default.
    chooseMode :: MonadState (Heist b1) m
               => m b
                   -- ^ A compiled action
               -> m b
                   -- ^ An interpreted action
               -> m b
    chooseMode cAction iAction = do
        mode <- gets _defMode
        case mode of
          Compiled -> cAction
          Interpreted -> iAction

    ------------------------------------------------------------------------------
    -- | Like render/cRender, but chooses between the two appropriately based on
    -- the default mode.
    gRender :: ByteString
               -- ^ Name of the template
            -> Handler b (Heist b) ()
    gRender t = chooseMode (cRender t) (render t)

    ------------------------------------------------------------------------------
    -- | Like renderAs/cRenderAs, but chooses between the two appropriately based
    -- on the default mode.
    gRenderAs :: ByteString
                 -- ^ Content type
              -> ByteString
                 -- ^ Name of the template
              -> Handler b (Heist b) ()
    gRenderAs ct t = chooseMode (cRenderAs ct t) (renderAs ct t)

    ------------------------------------------------------------------------------
    -- | Like heistServe/cHeistServe, but chooses between the two appropriately
    -- based on the default mode.
    gHeistServe :: Handler b (Heist b) ()
    gHeistServe = chooseMode cHeistServe heistServe

    ------------------------------------------------------------------------------
    -- | Like heistServeSingle/cHeistServeSingle, but chooses between the two
    -- appropriately based on the default mode.
    gHeistServeSingle :: ByteString -> Handler b (Heist b) ()
    gHeistServeSingle t = chooseMode (cHeistServeSingle t) (heistServeSingle t)

    ------------------------------------------------------------------------------
    heistLocal' :: SnapletLens (Snaplet b) (Heist b)
                -> (HeistState (Handler b b) -> HeistState (Handler b b))
                -> Handler b v a
                -> Handler b v a
    heistLocal' heist f m = do
        hs  <- withTop' heist get
        withTop' heist $ modify $ changeState f
        res <- m
        withTop' heist $ put hs
        return res

    ------------------------------------------------------------------------------
    heistLocal :: SnapletLens b (Heist b)
               -> (HeistState (Handler b b) -> HeistState (Handler b b))
               -> Handler b v a
               -> Handler b v a
    heistLocal heist f m = heistLocal' (subSnaplet heist) f m

    ------------------------------------------------------------------------------
    withSplices' :: SnapletLens (Snaplet b) (Heist b)
                 -> Splices (SnapletISplice b)
                 -> Handler b v a
                 -> Handler b v a
    withSplices' heist splices m = do
        heistLocal' heist (I.bindSplices splices) m

    ------------------------------------------------------------------------------
    withSplices :: SnapletLens b (Heist b)
                -> Splices (SnapletISplice b)
                -> Handler b v a
                -> Handler b v a
    withSplices heist splices m = withSplices' (subSnaplet heist) splices m

    ------------------------------------------------------------------------------
    renderWithSplices' :: SnapletLens (Snaplet b) (Heist b)
                       -> ByteString
                       -> Splices (SnapletISplice b)
                       -> Handler b v ()
    renderWithSplices' heist t splices =
        withSplices' heist splices $ withTop' heist $ render t

    ------------------------------------------------------------------------------
    renderWithSplices :: SnapletLens b (Heist b)
                      -> ByteString
                      -> Splices (SnapletISplice b)
                      -> Handler b v ()
    renderWithSplices heist t splices =
        renderWithSplices' (subSnaplet heist) t splices