module Plat.Context
(
 Context,
 ContextElement(..),
 Ctx(..),
 ElementC(..),
 context,
 listValues,
 (=:)
) where
import Control.Monad.Writer
import qualified Data.ByteString.UTF8 as B
import qualified Data.Map as M
import Data.Monoid
newtype Ctx = Ctx (M.Map B.ByteString ContextElement)

-- | This is a universal type for everything that can be assigned to a field in the
-- context. Normally you won't need this, and this type is subject to change, so,
-- it's internals are hidden. The only way to create values of this type is to use
-- the 'ec' (or the 'ecs') function. The only way to use them is to insert them into the
-- 'Context' with the '=:' operator and then render into the template.
--
-- One possible use of this type is to create a heterogeneous array. If you want
-- an array in your context, containing, for example, both strings and booleans,
-- you can do it like that: \'@[ec \"foo\", ec True]@\'.

data ContextElement =
    StringContext B.ByteString | 
    ListContext [ContextElement] | 
    SubContext Ctx | 
    BoolContext Bool
instance Monoid Ctx where
    mempty = Ctx (M.empty)
    Ctx m1 `mappend` Ctx m2 =
        Ctx (M.unionWithKey (\k _ _ -> error $ "duplicate name: " ++ B.toString k) m1 m2)

-- | This is the type of contexts. The type \'a\' here doesn't matter; it's only present
-- so that it would be possible to use the \'do\' syntax.

newtype Context a = Context (Writer Ctx a)
instance Monad Context where
    return = Context . return
    Context w >>= f = Context (w >>= \x -> let Context w' = f x in w')
context :: Context a -> Ctx
context (Context w) = execWriter w

-- | This is the class of all types that can be used as values in the context. You can
-- create additional ones, although we strictly discourage that.

class ElementC c where
    ec :: c -> ContextElement

    -- ^ This function is something you should implement yourself, if you decide to
    -- create your own instance of 'ElementC'. It converts the given value to the
    -- element that could be used in the context. Normally you can just go with the
    -- '=:' operator without calling this function explicitly.

    ecs :: [c] -> ContextElement

    -- ^ This function is here for the same reason the 'showList' function is in the
    -- 'Show' class — to allow 'String's, which are lists of characters, to be used
    -- differently from other lists.
    --
    -- If you decide to create your own instance of 'ElementC', there is no need to
    -- implement this function, as it has the default implementation.

    ecs = ListContext . map ec
instance ElementC Char where
    ec = StringContext . B.fromString . return
    ecs = StringContext . B.fromString
instance ElementC Bool where ec = BoolContext
instance ElementC (Context a) where ec = SubContext . context
instance ElementC a => ElementC [a] where ec = ecs
instance ElementC B.ByteString where ec = StringContext
instance ElementC ContextElement where ec = id
infixr 3 =:

-- |An only 'Context'-specific operator.
--
-- \'@name =: value@\' tells render that \'@value@\' should be substituted for
-- \'@name@\' in a template.

(=:) :: ElementC a => String -> a -> Context ()
nm =: val = Context $ tell $ Ctx $ M.singleton (B.fromString nm) $ ec val

-- | This function is here for convenience only. If you have a list of elements
-- that can be inserted in the template, this function gives you an array of records,
-- one for each element of the original list, where each record contains the corresponding
-- element in it's \'item\' field. Additionally, it gives you boolean \'first\' and
-- \'last\' fields, true for the first and last elements of the list respectively,
-- and the \'only\' field that is true if and only if the list contains just one element.

listValues :: ElementC a => [a] -> [Context ()]
listValues [] = []
listValues [x] = [flo x True True True]
listValues (x:x':xs) = flo x True False False : rest x' xs
    where rest x [] = [flo x False True False]
          rest x (x':xs) = flo x False False False : rest x' xs
flo :: ElementC x => x -> Bool -> Bool -> Bool -> Context ()
flo x f l o =
    do "item" =: x
       "first" =: f
       "last" =: l
       "only" =: o