module Text.Hastache.Context (
mkStrContext
, mkGenericContext
) where
import Data.Data
import Data.Generics
import Data.Int
import Data.Word
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import Text.Hastache
x ~> f = f $ x
infixl 9 ~>
mkStrContext :: Monad m => (String -> MuType m) -> MuContext m
mkStrContext f a = decodeStr a ~> f
mkGenericContext :: (Monad m, Data a, Typeable1 m) => a -> MuContext m
mkGenericContext val = toGenTemp val ~> convertGenTempToContext
data TD m =
TSimple (MuType m)
| TObj [(String, TD m)]
| TList [TD m]
| TUnknown
deriving (Show)
toGenTemp :: (Data a, Monad m, Typeable1 m) => a -> TD m
toGenTemp a = zip fields (gmapQ procField a) ~> TObj
where
fields = toConstr a ~> constrFields
procField :: (Data a, Monad m, Typeable1 m) => a -> TD m
procField =
obj
`ext1Q` list
`extQ` (\(i::String) -> MuVariable (encodeStr i) ~> TSimple)
`extQ` (\(i::Char) -> MuVariable i ~> TSimple)
`extQ` (\(i::Double) -> MuVariable i ~> TSimple)
`extQ` (\(i::Float) -> MuVariable i ~> TSimple)
`extQ` (\(i::Int) -> MuVariable i ~> TSimple)
`extQ` (\(i::Int8) -> MuVariable i ~> TSimple)
`extQ` (\(i::Int16) -> MuVariable i ~> TSimple)
`extQ` (\(i::Int32) -> MuVariable i ~> TSimple)
`extQ` (\(i::Int64) -> MuVariable i ~> TSimple)
`extQ` (\(i::Integer) -> MuVariable i ~> TSimple)
`extQ` (\(i::Word) -> MuVariable i ~> TSimple)
`extQ` (\(i::Word8) -> MuVariable i ~> TSimple)
`extQ` (\(i::Word16) -> MuVariable i ~> TSimple)
`extQ` (\(i::Word32) -> MuVariable i ~> TSimple)
`extQ` (\(i::Word64) -> MuVariable i ~> TSimple)
`extQ` (\(i::BS.ByteString) -> MuVariable i ~> TSimple)
`extQ` (\(i::LBS.ByteString) -> MuVariable i ~> TSimple)
`extQ` (\(i::Text.Text) -> MuVariable i ~> TSimple)
`extQ` (\(i::LText.Text) -> MuVariable i ~> TSimple)
`extQ` (\(i::Bool) -> MuBool i ~> TSimple)
`extQ` muLambdaBSBS
`extQ` muLambdaSS
`extQ` muLambdaBSLBS
`extQ` muLambdaMBSBS
`extQ` muLambdaMSS
`extQ` muLambdaMBSLBS
where
obj a = case dataTypeRep (dataTypeOf a) of
AlgRep [c] -> toGenTemp a
_ -> TUnknown
list a = map procField a ~> TList
muLambdaBSBS :: (BS.ByteString -> BS.ByteString) -> TD m
muLambdaBSBS f = MuLambda f ~> TSimple
muLambdaSS :: (String -> String) -> TD m
muLambdaSS f = MuLambda fd ~> TSimple
where
fd s = decodeStr s ~> f
muLambdaBSLBS :: (BS.ByteString -> LBS.ByteString) -> TD m
muLambdaBSLBS f = MuLambda f ~> TSimple
muLambdaMBSBS :: (BS.ByteString -> m BS.ByteString) -> TD m
muLambdaMBSBS f = MuLambdaM f ~> TSimple
muLambdaMSS :: (String -> m String) -> TD m
muLambdaMSS f = MuLambdaM fd ~> TSimple
where
fd s = decodeStr s ~> f
muLambdaMBSLBS :: (BS.ByteString -> m LBS.ByteString) -> TD m
muLambdaMBSLBS f = MuLambdaM f ~> TSimple
convertGenTempToContext :: TD t -> MuContext t
convertGenTempToContext v = mkMap "" Map.empty v ~> mkMapContext
where
mkMap name m (TSimple t) = Map.insert (encodeStr name) t m
mkMap name m (TObj lst) = foldl (foldTObj name) m lst ~>
Map.insert (encodeStr name)
([foldl (foldTObj "") Map.empty lst ~> mkMapContext] ~> MuList)
mkMap name m (TList lst) = Map.insert (encodeStr name)
(map convertGenTempToContext lst ~> MuList) m
mkMap _ m _ = m
mkName name newName = if length name > 0
then concat [name, ".", newName]
else newName
foldTObj name m (fn, fv) = mkMap (mkName name fn) m fv
mkMapContext m a = case Map.lookup a m of
Nothing ->
case a == dotBS of
True ->
case Map.lookup BS.empty m of
Nothing -> MuNothing
Just a -> a
_ -> MuNothing
Just a -> a
dotBS = encodeStr "."