{-# LANGUAGE OverloadedStrings #-}

{-|

This module contains helpers to make Heist fit in more closely within
`Fn`'s stance against monad transformers and for regular functions.

In particular, it instantiates the Monad for HeistState to be a
ReaderT that contains our context, so that in the splices we can get
the context out.

Further, we add splice builders that work similar to our url
routing - splices are declared to have certain attributes of specific
types, and the splice that correspond is a function that takes those
as arguments (and takes the context and the node as well).

-}

module Web.Fn.Extra.Heist ( -- * Types
                            HeistContext(..)
                          , FnHeistState
                          , FnSplice
                            -- * Initializer
                          , heistInit
                            -- * Rendering templates
                          , heistServe
                          , render
                          , renderWithSplices
                            -- * Building splices
                          , tag
                          , tag'
                          , FromAttribute(..)
                          , attr
                          , attrOpt
                          , (&=)
                          ) where

import           Blaze.ByteString.Builder
import           Control.Arrow                 (first)
import           Control.Lens
import           Control.Monad.State
import           Control.Monad.Trans.Either
import qualified Data.ByteString.Lazy.Internal as BS
import           Data.Monoid
import           Data.Text                     (Text)
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as T
import           Data.Text.Read                (decimal, double)
import           Heist
import qualified Heist.Compiled                as HC
import           Heist.Interpreted
import           Network.HTTP.Types
import           Network.Wai
import qualified Network.Wai.Util              as W
import qualified Text.XmlHtml                  as X
import           Web.Fn

-- | The type of our state. We need a ReaderT to be able to pass the
-- runtime context (which includes the current request) into the
-- splices.
type FnHeistState ctxt = HeistState (StateT ctxt IO)

-- | The type of our splice. We need a ReaderT to be able to pass the
-- runtime context (which includes the current request) into the
-- splice.
type FnSplice ctxt = Splice (StateT ctxt IO)

-- | In order to have render be able to get the 'FnHeistState' out of
-- our context, we need this helper class.
class HeistContext ctxt where
  getHeist :: ctxt -> FnHeistState ctxt

-- | Initialize heist. This takes a list of paths to template
-- directories and a set of interpreted splices. Currently, we don't
-- have support for compiled splices yet (so you can drop down to just
-- plain Heist if you want them).
heistInit :: HeistContext ctxt =>
             [Text] ->
             Splices (Splice (StateT ctxt IO)) ->
             Splices (HC.Splice (StateT ctxt IO)) ->
             IO (Either [String] (FnHeistState ctxt))
heistInit templateLocations splices cSplices=
  do let ts = map (loadTemplates . T.unpack) templateLocations
     let h = runEitherT $ initHeist (emptyHeistConfig & hcTemplateLocations .~ ts
                                    & hcInterpretedSplices .~ splices
                                    & hcLoadTimeSplices .~ defaultLoadTimeSplices
                                    & hcCompiledSplices .~ cSplices
                                    & hcNamespace .~ "")
     h' <- h
     case h' of
       Left e -> print e
       Right s -> print $ "Found: " <> (show $ templateNames s)
                    <> (show $ compiledTemplateNames s)
                   <> (show $ spliceNames s)
                   <> (show $ compiledSpliceNames s)
     h

-- | Render templates according to the request path. Note that if you
-- have matched some parts of the path, those will not be included in
-- the path used to find the templates. For example, if you have
-- @foo\/bar.tpl@ in the directory where you loaded templates from,
--
-- > path "foo" ==> heistServe
--
-- Will match @foo\/foo\/bar@, but not @foo\/bar@. To match that, you could:
--
-- > anything ==> heistServe
--
-- If no template is found, this will continue routing.
heistServe :: (RequestContext ctxt, HeistContext ctxt) =>
              ctxt ->
              IO (Maybe Response)
heistServe ctxt = do
  let p = pathInfo . fst $ getRequest ctxt
  render ctxt (T.intercalate "/" p)

-- | Render a single template by name.
render :: HeistContext ctxt =>
          ctxt ->
          Text ->
          IO (Maybe Response)
render ctxt name = do
  renderWithSplices ctxt name mempty

-- | Render a template, and add additional interpreted splices before
-- doing so.
renderWithSplices :: HeistContext ctxt =>
                     ctxt ->
                     Text ->
                     Splices (FnSplice ctxt) ->
                     IO (Maybe Response)
renderWithSplices ctxt name splices =
  do let r = (HC.renderTemplate (getHeist ctxt) (T.encodeUtf8 name))
     case r of
       Just (h,m) -> do
         let h' = runStateT h ctxt
         h'' <- toLazyByteString . fst <$> h'
         Just <$> (W.bytestring status200 [(hContentType, m)] h'')
       Nothing  -> return Nothing
     -- r' = (ReaderT ctxt io Builder, MIME)
     --
     --r <- runReaderT (renderTemplate (bindSplices splices (getHeist ctxt)) (T.encodeUtf8 name)) ctxt
     --if hasTemplate (T.encodeUtf8 name) (getHeist ctxt) then print "found" else print "can't find"
     --print $ "Found: " <> (show $ templateNames (getHeist ctxt))
{--
     case first toLazyByteString <$> r' of
       Nothing -> do
         print "NOTHING"
         return Nothing
       Just (h,m) -> Just <$> W.bytestring status200 [(hContentType, m)] h
--}

-- | In order to make splice definitions more functional, we declare
-- them and the attributes they need, along with deserialization (if
-- needed). The deserialization is facilitated be this class.
class FromAttribute a where
  fromAttribute :: Text -> Maybe a

instance FromAttribute Text where
  fromAttribute = Just
instance FromAttribute Int where
  fromAttribute t = case decimal t of
                           Left _ -> Nothing
                           Right m | snd m /= "" ->
                                     Nothing
                           Right (v, _) -> Just v
instance FromAttribute Double where
  fromAttribute t = case double t of
                           Left _ -> Nothing
                           Right m | snd m /= "" ->
                                     Nothing
                           Right (v, _) -> Just v

-- | This declares a new splice. Given a name, an attribute matcher,
-- and a handler function (which takes the context, the node, and the
-- specified attributes), it will pass the handler function the
-- provided attributes or return nothing, if the attributes are
-- missing / not deserializable.
--
-- Note that due to the dynamism (the handler function can have any
-- number of arguments, and the number / type of them is based on the
-- matcher), the types of this may be a little confusing (in
-- particular, the `k` contains a lot). This continuation-based style
-- lets us achieve this style, but the types suffer. It may be easier
-- to see via an example:
--
-- @
--  tag "posts" (attr "num" & attr "sort") $ \\ctxt node num sort -> ...
-- @
tag :: Text ->
       (X.Node -> k -> Maybe (X.Node, FnSplice ctxt)) ->
       (ctxt -> X.Node -> k) ->
       Splices (FnSplice ctxt)
tag name match handle =
  name ## do ctxt <- lift get
             node <- getParamNode
             case match node (handle ctxt node) of
               Nothing -> do tellSpliceError $
                              "Invalid attributes for splice '" <>
                              name <> "'"
                             return []
               Just (_, a) -> a

-- | A tag with no attributes.
tag' :: Text ->
        (ctxt -> X.Node -> FnSplice ctxt) ->
        Splices (FnSplice ctxt)
tag' name handle =
  name ## do ctxt <- lift get
             node <- getParamNode
             handle ctxt node


-- | This combines two matchers together.
(&=) :: (X.Node -> k -> Maybe (X.Node, k')) ->
        (X.Node -> k' -> Maybe (X.Node, a)) ->
        X.Node ->
        k -> Maybe (X.Node, a)
(&=) a1 a2 node k =
  case a1 node k of
    Nothing -> Nothing
    Just (_, k') -> a2 node k'

-- | This specifies that an attribute should be present and
-- convertable to the type indicated by it's type.
attr :: FromAttribute a =>
        Text ->
        X.Node ->
        (a -> t) ->
        Maybe (X.Node, t)
attr name node k = case X.getAttribute name node >>= fromAttribute of
                     Nothing -> Nothing
                     Just a -> Just (node, k a)

-- | This specifies that an attribute is optional - if absent or not
-- convertable, 'Nothing' will be passed.
attrOpt :: FromAttribute a =>
           Text ->
           X.Node ->
           (Maybe a -> t) ->
           Maybe (X.Node, t)
attrOpt name node k =
  Just (node, k (X.getAttribute name node >>= fromAttribute))
