Remove ExistentialQuantification

Add a few smart constructors to make working with the datatype easier in the absence of the extension.
singpolyma · Aug 15, 2012 · aa89768 · aa89768
1 parent 650394b
commit aa89768
Show file tree

Hide file tree

Showing 2 changed files with 60 additions and 42 deletions.
diff --git a/Text/Hastache.hs b/Text/Hastache.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
 -- Module:      Text.Hastache
 -- Copyright:   Sergey S Lymar (c) 2011 
 -- License:     BSD3
@@ -68,6 +68,9 @@ module Text.Hastache (
     , hastacheFileBuilder
     , MuContext
     , MuType(..)
+    , muVariable
+    , muLambda
+    , muLambdaM
     , MuConfig(..)
     , MuVar(..)
     , htmlEscape
@@ -79,7 +82,7 @@ module Text.Hastache (
     , decodeStrLBS
     ) where 
 
-import Control.Monad (guard, when)
+import Control.Monad (guard, when, liftM)
 import Control.Monad.Reader (ask, runReaderT, MonadReader, ReaderT)
 import Control.Monad.Trans (lift, liftIO, MonadIO)
 import Data.AEq (AEq,(~==))
@@ -165,12 +168,12 @@ instance MuVar a => MuVar [a] where
     toLByteString a = LZ.concat (map toLByteString a)
     isEmpty a = Prelude.length a == 0
 
-data MuType m = 
-    forall a. MuVar a => MuVariable a                   |
-    MuList [MuContext m]                                |
-    MuBool Bool                                         |
-    forall a. MuVar a => MuLambda (ByteString -> a)     |
-    forall a. MuVar a => MuLambdaM (ByteString -> m a)  |
+data MuType m =
+    MuVariable (LZ.ByteString, Bool)                  |
+    MuList [MuContext m]                              |
+    MuBool Bool                                       |
+    MuLambda (ByteString -> (LZ.ByteString, Bool))    |
+    MuLambdaM (ByteString -> m (LZ.ByteString, Bool)) |
     MuNothing
 
 instance Show (MuType m) where
@@ -181,6 +184,21 @@ instance Show (MuType m) where
     show (MuLambdaM _) = "MuLambdaM <..>"
     show MuNothing = "MuNothing"
 
+muTuple :: (MuVar a) => a -> (LZ.ByteString, Bool)
+muTuple a = (toLByteString a, isEmpty a)
+
+-- | Smart constructor for MuVariable
+muVariable :: (MuVar a) => a -> MuType m
+muVariable = MuVariable . muTuple
+
+-- | Smart constructor for MuLambda
+muLambda :: (MuVar a) => (ByteString -> a) -> MuType m
+muLambda f = MuLambda (muTuple . f)
+
+-- | Smart constructor for MuLambdaM
+muLambdaM :: (MuVar a, Monad m) => (ByteString -> m a) -> MuType m
+muLambdaM f = MuLambdaM (\x -> muTuple `liftM` f x)
+
 data MuConfig = MuConfig {
     muEscapeFunc        :: LZ.ByteString -> LZ.ByteString, 
         -- ^ Escape function ('htmlEscape', 'emptyEscape' etc.)
@@ -272,7 +290,7 @@ readVar :: MonadIO m => [MuContext m] -> ByteString -> LZ.ByteString
 readVar [] _ = LZ.empty
 readVar (context:parentCtx) name =
     case context name of
-        MuVariable a -> toLByteString a
+        MuVariable (lbs,_) -> lbs
         MuBool a -> show a ~> encodeStr ~> toLBS
         MuNothing -> case tryFindArrayItem context name of
             Just (nctx,nn) -> readVar [nctx] nn
@@ -402,22 +420,22 @@ renderBlock contexts symb inTag afterClose otag ctag conf
                             mapM_ (\c -> processBlock sectionContent
                                 (c:contexts) otag ctag conf) b
                             next afterSection
-                        Just (MuVariable a) -> if isEmpty a 
+                        Just (MuVariable (_,isE)) -> if isE
                             then next afterSection
                             else processAndNext
                         Just (MuBool True) -> processAndNext
                         Just (MuLambda func) -> do
-                            func sectionContent ~> toLByteString ~> addResLZ
+                            func sectionContent ~> fst ~> addResLZ
                             next afterSection
                         Just (MuLambdaM func) -> do
-                            res <- lift (func sectionContent)
-                            toLByteString res ~> addResLZ
+                            (res,_) <- lift (func sectionContent)
+                            res ~> addResLZ
                             next afterSection
                         _ -> next afterSection
                     else case readContext of -- inverted section
                         Just (MuList []) -> processAndNext
                         Just (MuBool False) -> processAndNext
-                        Just (MuVariable a) -> if isEmpty a 
+                        Just (MuVariable (_,isE)) -> if isE
                             then processAndNext
                             else next afterSection
                         Nothing -> processAndNext

diff --git a/Text/Hastache/Context.hs b/Text/Hastache/Context.hs
@@ -184,25 +184,25 @@ 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::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
@@ -219,28 +219,28 @@ procField =
     list a = map procField a ~> TList
 
     muLambdaBSBS :: (BS.ByteString -> BS.ByteString) -> TD m
-    muLambdaBSBS f = MuLambda f ~> TSimple
+    muLambdaBSBS f = muLambda f ~> TSimple
 
     muLambdaSS :: (String -> String) -> TD m
-    muLambdaSS f = MuLambda fd ~> TSimple
+    muLambdaSS f = muLambda fd ~> TSimple
         where
         fd s = decodeStr s ~> f
 
     muLambdaBSLBS :: (BS.ByteString -> LBS.ByteString) -> TD m
-    muLambdaBSLBS f = MuLambda f ~> TSimple
+    muLambdaBSLBS f = muLambda f ~> TSimple
 
     -- monadic
 
-    muLambdaMBSBS :: (BS.ByteString -> m BS.ByteString) -> TD m
-    muLambdaMBSBS f = MuLambdaM f ~> TSimple
+    muLambdaMBSBS :: (Monad m) => (BS.ByteString -> m BS.ByteString) -> TD m
+    muLambdaMBSBS f = muLambdaM f ~> TSimple
 
-    muLambdaMSS :: (String -> m String) -> TD m
-    muLambdaMSS f = MuLambdaM fd ~> TSimple
+    muLambdaMSS :: (Monad m) => (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
+    muLambdaMBSLBS :: (Monad m) => (BS.ByteString -> m LBS.ByteString) -> TD m
+    muLambdaMBSLBS f = muLambdaM f ~> TSimple
 
 convertGenTempToContext :: TD t -> MuContext t
 convertGenTempToContext v = mkMap "" Map.empty v ~> mkMapContext