glabrous 0.1.2.0 → 0.1.3.0

raw patch · 5 files changed

+158/−150 lines, 5 filesdep +cerealdep +cereal-textPVP ok

version bump matches the API change (PVP)

Dependencies added: cereal, cereal-text

API changes (from Hackage documentation)

Files

• README.md +1/−1
• glabrous.cabal +10/−7
• src/Text/Glabrous.hs +101/−119
• src/Text/Glabrous/Internal.hs +17/−13
• src/Text/Glabrous/Types.hs +29/−10

@@ -1,5 +1,5 @@ # Glabrous [![Build Status](https://travis-ci.org/MichelBoucey/glabrous.svg?branch=master)](https://travis-ci.org/MichelBoucey/glabrous) -Glabrous is a minimalistic Mustache-like syntax - using only the simplest Mustache tag: {{name}} -, truly logic-less, HTML agnostic pure Text template library.+Glabrous is a minimalistic Mustache-like syntax - using only the simplest Mustache tag: {{name}} -, truly logic-less, HTML agnostic pure Text template DSL library.  Any improvement is welcome.

@@ -1,14 +1,14 @@ name:                glabrous-version:             0.1.2.0-synopsis:            A template library+version:             0.1.3.0+synopsis:            A template DSL library description:         A minimalistic, Mustache-like syntax, truly logic-less,-                     pure Text template library+                     pure Text template DSL library homepage:            https://github.com/MichelBoucey/glabrous license:             BSD3 license-file:        LICENSE author:              Michel Boucey-maintainer:          michel.boucey@gmail.com-copyright:           2016 (c) Michel Boucey+maintainer:          michel.boucey@cybervisible.fr+copyright:           (c) 2016 - Michel Boucey category:            Text, Web build-type:          Simple cabal-version:       >=1.10@@ -16,17 +16,20 @@  source-repository head   type:     git-  location: https://github.com/MichelBoucey/glabrous.git+  location: git://github.com/MichelBoucey/glabrous.git  library   hs-source-dirs:      src-  exposed-modules:     Text.Glabrous, Text.Glabrous.Types+  exposed-modules:     Text.Glabrous+                     , Text.Glabrous.Types   other-modules:       Text.Glabrous.Internal   build-depends:       aeson >= 0.11                      , aeson-pretty >= 0.7                      , attoparsec >= 0.13                      , base >= 4.7 && < 5                      , bytestring >= 0.10.6+                     , cereal >= 0.5.2+                     , cereal-text                      , either >= 4.4                      , text >= 1.2                      , unordered-containers >= 0.2

@@ -10,60 +10,52 @@ --  module Text.Glabrous-    (--    -- * 'Template'--      Template (..)-    , Tag--    -- ** Get a 'Template'--    , fromText-    , readTemplateFile--    -- ** 'Template' operations--    , toText-    , isFinal-    , tagsOf-    , tagsRename-    , compress-    , writeTemplateFile--    -- * 'Context'--    , Context (..)+  ( -    -- ** Get a 'Context'+  -- * 'Template'+    Template (..)+  , Tag -    , initContext-    , fromList-    , fromTemplate+  -- ** Get a 'Template'+  , fromText+  , readTemplateFile -    -- ** 'Context' operations+  -- ** 'Template' operations+  , toText+  , isFinal+  , tagsOf+  , tagsRename+  , compress+  , writeTemplateFile -    , setVariables-    , deleteVariables-    , variablesOf-    , isSet-    , unsetContext+  -- * 'Context'+  , Context (..) -    -- ** JSON 'Context' file+  -- ** Get a 'Context'+  , initContext+  , fromList+  , fromTemplate -    , readContextFile-    , writeContextFile-    , initContextFile+  -- ** 'Context' operations+  , setVariables+  , deleteVariables+  , variablesOf+  , isSet+  , unsetContext -    -- * Processing+  -- ** JSON 'Context' file+  , readContextFile+  , writeContextFile+  , initContextFile -    , process-    , processWithDefault-    , partialProcess-    , G.Result (..)-    , partialProcess'+  -- * Processing+  , process+  , processWithDefault+  , partialProcess+  , G.Result (..)+  , partialProcess' -    ) where+  ) where  import           Control.Monad import           Data.Aeson@@ -79,24 +71,22 @@  -- | Optimize a 'Template' content after (many) 'partialProcess'(') rewriting(s). compress :: Template -> Template-compress Template {..} =-    Template { content = go content [] }+compress Template{..} =+  Template { content = go content [] }   where     go ts !ac = do-        let (a,b) = span isLiteral ts-            u = uncons b-        if not (null a)-            then case u of-                Just (c,d) -> go d (ac ++ [concatLiterals a] ++ [c])-                Nothing    -> ac ++ [concatLiterals a]-            else case u of-                Just (e,f) -> go f (ac ++ [e])-                Nothing    -> ac+      let (a,b) = span isLiteral ts+          u = uncons b+      if not (null a)+        then case u of+          Just (c,d) -> go d (ac ++ [concatLiterals a] ++ [c])+          Nothing    -> ac ++ [concatLiterals a]+        else case u of+          Just (e,f) -> go f (ac ++ [e])+          Nothing    -> ac       where-        isLiteral (Literal _) = True-        isLiteral (Tag _)     = False         concatLiterals =-            foldr trans (Literal "")+          foldr trans (Literal "")           where             trans (Literal a) (Literal b) = Literal (a `T.append` b)             trans _           _           = undefined@@ -110,26 +100,26 @@ -- >λ>setVariables [("something","something new"), ("about","Haskell")] context -- >Context {variables = fromList [("etc.","..."),("about","Haskell"),("something","something new"),("name","")]} setVariables :: [(T.Text,T.Text)] -> Context -> Context-setVariables ts Context {..} =-    go ts variables+setVariables ts Context{..} =+  go ts variables   where     go _ts vs =-        case uncons _ts of-            Just ((k,v),ts') -> go ts' $ H.insert k v vs-            Nothing          -> Context { variables = vs }+      case uncons _ts of+        Just ((k,v),ts') -> go ts' $ H.insert k v vs+        Nothing          -> Context { variables = vs }  -- | Delete variables from a 'Context' by these names. -- -- >λ>deleteVariables ["something"] context -- >Context {variables = fromList [("etc.","..."),("about","Haskell"),("name","")]} deleteVariables :: [T.Text] -> Context -> Context-deleteVariables ts Context {..} =-    go ts variables+deleteVariables ts Context{..} =+  go ts variables   where     go _ts vs =-        case uncons _ts of-            Just (k,ts') -> go ts' $ H.delete k vs-            Nothing      -> Context { variables = vs }+      case uncons _ts of+        Just (k,ts') -> go ts' $ H.delete k vs+        Nothing      -> Context { variables = vs }  -- | Build a 'Context' from a list of 'Tag's and replacement 'T.Text's. --@@ -172,7 +162,7 @@ -- initContextFile :: FilePath -> Context -> IO () initContextFile f Context {..} = L.writeFile f $-    encodePretty Context { variables = H.map (const T.empty) variables }+  encodePretty Context { variables = H.map (const T.empty) variables }  -- | Build 'Just' a (sub)'Context' made of unset variables -- of the given context, or 'Nothing'.@@ -182,19 +172,19 @@ -- unsetContext :: Context -> Maybe Context unsetContext Context {..} = do-    let vs = H.filter (== T.empty) variables-    guard (vs /= H.empty)-    return Context { variables = vs }+  let vs = H.filter (== T.empty) variables+  guard (vs /= H.empty)+  return Context { variables = vs }  -- | 'True' if the all variables of--- the given 'Context' are not empty+-- the given 'Context' are not empty. isSet :: Context -> Bool-isSet Context {..} =-    H.foldr (\v b -> b && v /= T.empty) True variables+isSet Context{..} =+  H.foldr (\v b -> b && v /= T.empty) True variables  -- | Get the list of the given 'Context' variables variablesOf :: Context -> [T.Text]-variablesOf Context {..} = H.keys variables+variablesOf Context{..} = H.keys variables  -- | Get a 'Template' from a file. readTemplateFile :: FilePath -> IO (Either String Template)@@ -205,46 +195,37 @@ writeTemplateFile f t = I.writeFile f $ toText t  -- | Output the content of the given 'Template'--- as it is, with its 'Tag's, if they exist (no--- 'Context' is processed).+-- as it is, with its 'Tag's, if they exist. No+-- 'Context' is processed. toText :: Template -> T.Text-toText Template {..} =-    T.concat $ trans <$> content+toText Template{..} =+  T.concat $ trans <$> content   where     trans (Literal c) = c     trans (Tag k)     = T.concat ["{{",k,"}}"]  -- | Get the list of 'Tag's in the given 'Template'. tagsOf :: Template -> [Tag]-tagsOf Template {..} =-    (\(Tag k) -> k) <$> filter isTag content+tagsOf Template{..} =+  (\(Tag k) -> k) <$> filter isTag content   where     isTag (Tag _) = True     isTag _       = False  tagsRename :: [(T.Text,T.Text)] -> Template -> Template-tagsRename ts Template {..} =-    Template { content = rename <$> content }+tagsRename ts Template{..} =+  Template { content = rename <$> content }   where     rename t@(Tag n) =-        case lookup n ts of-            Just r  -> Tag r-            Nothing -> t+      case lookup n ts of+        Just r  -> Tag r+        Nothing -> t     rename l@(Literal _) = l  -- | 'True' if a 'Template' has no more 'Tag' -- inside and can be used as a final 'T.Text'. isFinal :: Template -> Bool-isFinal Template {..} =-    allLiteral content-  where-    allLiteral t =-        case uncons t of-            Just (t',ts) ->-                case t' of-                    Literal _ -> allLiteral ts-                    Tag _     -> False-            Nothing      -> True+isFinal Template{..} = all isLiteral content  -- | Process, discard 'Tag's which are not in the 'Context' -- and leave them without replacement text in the final 'T.Text'.@@ -253,25 +234,26 @@  -- | Process and replace missing variables in 'Context' -- with the given default replacement 'T.Text'.-processWithDefault :: T.Text    -- ^ Default replacement text-                   -> Template-                   -> Context-                   -> T.Text-processWithDefault d Template {..} c = toTextWithContext (const d) c content+processWithDefault+  :: T.Text    -- ^ Default replacement text+  -> Template+  -> Context+  -> T.Text+processWithDefault d Template{..} c = toTextWithContext (const d) c content  -- | Process a (sub)'Context' present in the given template, leaving -- untouched, if they exist, other 'Tag's, to obtain a new template. partialProcess :: Template -> Context -> Template-partialProcess Template {..} c =-    Template { content = transTags content c }+partialProcess Template{..} c =+  Template { content = transTags content c }   where     transTags ts Context{..} =-        trans <$> ts+      trans <$> ts       where         trans i@(Tag k) =-            case H.lookup k variables of-                Just v  -> Literal v-                Nothing -> i+          case H.lookup k variables of+            Just v  -> Literal v+            Nothing -> i         trans t = t  -- | Process a (sub)'Context' present in the given template, and@@ -281,16 +263,16 @@ -- >λ>partialProcess' template context -- >Partial {template = Template {content = [Literal "Some ",Tag "tags",Literal " are unused in this ",Tag "text",Literal "."]}, tags = ["tags","text"]} partialProcess' :: Template -> Context -> G.Result-partialProcess' t c@Context {..} =-    case foldl trans ([],[]) (content t) of-        (f,[]) -> Final $ toTextWithContext (const T.empty) c f-        (p,p') -> G.Partial Template { content = p } p'+partialProcess' t c@Context{..} =+  case foldl trans ([],[]) (content t) of+    (f,[]) -> Final $ toTextWithContext (const T.empty) c f+    (p,p') -> G.Partial Template { content = p } p'   where     trans (!c',!ts) t' =-        case t' of-            Tag k     ->-                case H.lookup k variables of-                    Just v  -> (c' ++ [Literal v],ts)-                    Nothing -> (c' ++ [t'],ts ++ [k])-            Literal _ -> (c' ++ [t'],ts)+      case t' of+        Tag k     ->+          case H.lookup k variables of+            Just v  -> (c' ++ [Literal v],ts)+            Nothing -> (c' ++ [t'],ts ++ [k])+        Literal _ -> (c' ++ [t'],ts) 

@@ -13,7 +13,7 @@  toTextWithContext :: (T.Text -> T.Text) -> Context -> [Token] -> T.Text toTextWithContext tagDefault Context{..} ts =-    T.concat $ trans <$> ts+  T.concat $ trans <$> ts   where     trans (Tag k)     = fromMaybe (tagDefault k) (H.lookup k variables)     trans (Literal c) = c@@ -25,26 +25,30 @@ -- fromText :: T.Text -> Either String Template fromText t =-    case parseOnly tokens t of-        Right ts -> Right Template { content = ts }-        Left e   -> Left e+  case parseOnly tokens t of+    Right ts -> Right Template { content = ts }+    Left e   -> Left e +isLiteral :: Token -> Bool+isLiteral (Literal _) = True+isLiteral _           = False+ tokens :: Parser [Token] tokens =-    many' token+  many' token   where     token = literal <|> tag <|> leftover     leftover = do-        c <- takeWhile1 $ not . content-        return (Literal c)+      c <- takeWhile1 $ not . content+      return (Literal c)     literal = do-        c <- takeWhile1 content-        return (Literal c)+      c <- takeWhile1 content+      return (Literal c)     tag = do-        _ <- string "{{"-        Literal t <- literal-        _ <- string "}}"-        return (Tag t)+      _ <- string "{{"+      Literal t <- literal+      _ <- string "}}"+      return (Tag t)     content '}' = False     content '{' = False     content _   = True

@@ -1,28 +1,47 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}  module Text.Glabrous.Types where  import           Data.Aeson import qualified Data.HashMap.Strict as H import qualified Data.Text           as T+import           Data.Serialize+import           Data.Serialize.Text ()+import           GHC.Generics -data Token = Tag !T.Text | Literal !T.Text deriving (Show,Eq)+data Token+  = Tag !T.Text+  | Literal !T.Text+  deriving (Eq, Show, Generic) -data Template = Template { content :: ![Token] } deriving (Show,Eq)+instance Serialize Token -data Context = Context { variables :: H.HashMap T.Text T.Text } deriving (Show,Eq)+data Template =+  Template+    { content :: ![Token] }+    deriving (Eq, Show, Generic) +instance Serialize Template++data Context =+  Context+    { variables :: H.HashMap T.Text T.Text }+    deriving (Eq, Show)+ instance ToJSON Context where-    toJSON (Context h) = object $ (\(k,v) -> (k,String v)) <$> H.toList h+  toJSON (Context h) =+    object $ (\(k,v) -> (k,String v)) <$> H.toList h  instance FromJSON Context where-    parseJSON (Object o) = return-        Context { variables =-                      H.fromList $ (\(k,String v) -> (k,v)) <$> H.toList o-                }-    parseJSON _          = fail "expected an object"+  parseJSON (Object o) = return+    Context { variables = H.fromList $ (\(k,String v) -> (k,v)) <$> H.toList o }+  parseJSON _         = fail "expected an object"  type Tag = T.Text -data Result = Final !T.Text | Partial { template :: !Template, tags :: ![Tag]}  deriving (Show,Eq)+data Result+  = Final !T.Text+  | Partial { template :: !Template , tags :: ![Tag] }+  deriving (Eq, Show)