doctemplates 0.4 → 0.5

raw patch · 6 files changed

+167/−43 lines, 6 filesdep +safePVP ok

version bump matches the API change (PVP)

Dependencies added: safe

API changes (from Hackage documentation)

Files

• changelog.md +27/−0
• doctemplates.cabal +2/−2
• src/Text/DocTemplates.hs +1/−1
• src/Text/DocTemplates/Internal.hs +112/−35
• test/empty.test +16/−0
• test/test.hs +9/−5

@@ -1,5 +1,32 @@ # doctemplates +## 0.5++  * Add toText method to TemplateTarget class.++  * Add String and Lazy Text instances for TemplateTarget.++  * Swap Parameters in ToContext (so that the first parameter+    for both ToContext and FromContext refers to the parameter+    of Context).++  * Add toVal method to ToContext.++  * Default instance definition for toContext in terms of toVal,+    so that defining toVal is sufficient.++  * Add instances for ToContext and FromContext.++  * Remove valueToContext. Add ToJSON, FromJSON instances+    for Context and Val instead.++  * isEmpty: For Doc, treat `Text 0 _` as empty.+    Also `Concat x y` when x and y are empty.+    This differs from isEmpty in DocLayout itself, which only+    applies to Empty.++  * Code cleanup.+ ## 0.4    * Split into three modules.  Main module only exports an

@@ -1,5 +1,5 @@ name:                doctemplates-version:             0.4+version:             0.5 synopsis:            Pandoc-style document templates description:         A simple text templating system used by pandoc. homepage:            https://github.com/jgm/doctemplates#readme@@ -24,6 +24,7 @@                        Text.DocTemplates.Parser                        Text.DocTemplates.Internal   build-depends:       base >= 4.9 && < 5,+                       safe,                        aeson,                        text,                        doclayout >= 0.1 && < 0.2,@@ -45,7 +46,6 @@   main-is:             test.hs   build-depends:       base,                        doctemplates,-                       mtl,                        aeson,                        Glob,                        tasty,

@@ -254,7 +254,7 @@ -- and 'renderTemplate'.  If a template will be rendered -- more than once in the same process, compile it separately -- for better performance.-applyTemplate :: (TemplateMonad m, TemplateTarget a, ToContext b a)+applyTemplate :: (TemplateMonad m, TemplateTarget a, ToContext a b)            => FilePath -> Text -> b -> m (Either String a) applyTemplate fp t val = do     res <- compileTemplate fp t

@@ -29,16 +29,17 @@       , Val(..)       , ToContext(..)       , FromContext(..)-      , valueToContext       , TemplateTarget(..)       , Template(..)       , Variable(..)       , Indented(..)       ) where -import Data.Aeson (Value(..), ToJSON(..))+import Safe (lastMay, initDef)+import Data.Aeson (Value(..), ToJSON(..), FromJSON(..), Result(..), fromJSON) import Control.Monad.Identity import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Text.IO as TIO import qualified Text.DocLayout as DL import Data.String (IsString(..))@@ -50,7 +51,7 @@ import qualified Data.HashMap.Strict as H import qualified Data.Vector as V import Data.Scientific (floatingOrInteger)-import Data.List (intersperse)+import Data.List (intersperse, intercalate) #if MIN_VERSION_base(4,11,0) #else import Data.Semigroup@@ -95,12 +96,14 @@ -- | A type to which templates can be rendered. class Monoid a => TemplateTarget a where   fromText           :: Text -> a+  toText             :: a -> Text   removeFinalNewline :: a -> a   isEmpty            :: a -> Bool   indent             :: Int -> a -> a  instance TemplateTarget Text where   fromText   = id+  toText     = id   removeFinalNewline t =     case T.unsnoc t of       Just (t', '\n') -> t'@@ -109,11 +112,38 @@   indent 0   = id   indent ind = T.intercalate ("\n" <> T.replicate ind " ") . T.lines -instance IsString a => TemplateTarget (DL.Doc a) where+instance TemplateTarget TL.Text where+  fromText   = TL.fromStrict+  toText     = TL.toStrict+  removeFinalNewline t =+    case TL.unsnoc t of+      Just (t', '\n') -> t'+      _               -> t+  isEmpty    = TL.null+  indent 0   = id+  indent ind = TL.intercalate ("\n" <> TL.replicate (fromIntegral ind) " ")+               . TL.lines++instance TemplateTarget String where+  fromText   = T.unpack+  toText     = T.pack+  removeFinalNewline t =+    case lastMay t of+      Just '\n'       -> initDef t t+      _               -> t+  isEmpty    = null+  indent 0   = id+  indent ind = intercalate ("\n" <> replicate ind ' ') . lines++instance (DL.HasChars a, IsString a) => TemplateTarget (DL.Doc a) where   fromText = DL.text . T.unpack+  toText   = T.pack . DL.foldrChar (:) [] . DL.render Nothing   removeFinalNewline = DL.chomp   indent = DL.nest-  isEmpty = DL.isEmpty+  isEmpty (DL.Empty)      = True+  isEmpty (DL.Text 0 _)   = True+  isEmpty (DL.Concat x y) = isEmpty x && isEmpty y+  isEmpty _               = False   -- | A 'Context' defines values for template's variables.@@ -129,16 +159,48 @@   deriving (Show, Traversable, Foldable, Functor)  -- | The 'ToContext' class provides automatic conversion to--- a 'Context'.-class ToContext b a where+-- a 'Context' or 'Val'.+class ToContext a b where   toContext :: b -> Context a--instance TemplateTarget a => ToContext Value a where-  toContext = valueToContext+  toContext x = case toVal x of+                  MapVal c -> c+                  _        -> mempty+  toVal     :: b -> Val a -instance ToContext (Context a) a where+instance TemplateTarget a => ToContext a (Context a) where   toContext = id+  toVal     = MapVal +instance TemplateTarget a => ToContext a (Val a) where+  toVal     = id++instance TemplateTarget a => ToContext a a where+  toVal     = SimpleVal++-- This is needed because otherwise the compiler tries to+-- match on ToContext a [b], with a = b = Char, even though+-- we don't have ToContext Char Char.  I don't understand why.+instance {-# OVERLAPS #-} ToContext String String where+  toVal t   = SimpleVal t++instance ToContext a b => ToContext a [b] where+  toVal     = ListVal . map toVal++instance TemplateTarget a => ToContext a Value where+  toContext x = case fromJSON x of+                  Success y -> y+                  Error _   -> mempty+  toVal x = case fromJSON x of+                  Success y -> y+                  Error _   -> NullVal++instance TemplateTarget a => ToContext a Bool where+  toVal True  = SimpleVal $ fromText "true"+  toVal False = NullVal++instance (TemplateTarget a, DL.HasChars a) => ToContext (DL.Doc a) a where+  toVal t   = SimpleVal $ DL.Text (DL.realLength t) t+ -- | The 'FromContext' class provides functions for extracting -- values from 'Val' and 'Context'. class FromContext a b where@@ -146,39 +208,54 @@   lookupContext :: Text -> Context a -> Maybe b   lookupContext t (Context m) = M.lookup t m >>= fromVal -instance FromContext a (Val a) where+instance TemplateTarget a => FromContext a (Val a) where   fromVal = Just -instance FromContext a a where+instance TemplateTarget a => FromContext a a where   fromVal (SimpleVal x) = Just x   fromVal _             = Nothing -instance FromContext a [a] where-  fromVal (SimpleVal x) = Just [x]-  fromVal (ListVal  xs) = mapM fromVal xs+-- This is needed because otherwise the compiler tries to+-- match on FromContext a [b], with a = b = Char, even though+-- we don't have FromContext Char Char.  I don't understand why.+instance {-# OVERLAPS #-} FromContext String String where+  fromVal (SimpleVal x) = Just x   fromVal _             = Nothing -valueToVal :: (TemplateTarget a, ToJSON b) => b -> Val a-valueToVal x =-  case toJSON x of-    Array vec   -> ListVal $ map valueToVal $ V.toList vec-    String t    -> SimpleVal $ fromText t-    Number n    -> SimpleVal $ fromText . fromString $-                           case floatingOrInteger n of-                                Left (r :: Double)   -> show r-                                Right (i :: Integer) -> show i-    Bool True   -> SimpleVal $ fromText "true"-    Object o    -> MapVal $ Context $ M.fromList $ H.toList $ H.map valueToVal o-    _           -> NullVal+instance FromContext a b => FromContext a [b] where+  fromVal (ListVal  xs) = mapM fromVal xs+  fromVal x             = sequence [fromVal x] --- | Converts an Aeson 'Value' to a 'Context'.-valueToContext :: (TemplateTarget a, ToJSON b) => b -> Context a-valueToContext val =-  case valueToVal val of-    MapVal o -> o-    _        -> Context mempty+instance TemplateTarget a => FromJSON (Context a) where+  parseJSON v = do+    val <- parseJSON v+    case val of+      MapVal o -> return o+      _        -> fail "Not a MapVal" +instance TemplateTarget a => FromJSON (Val a) where+  parseJSON v =+    case v of+      Array vec   -> ListVal <$> mapM parseJSON (V.toList vec)+      String t    -> return $ SimpleVal $ fromText t+      Number n    -> return $ SimpleVal $ fromText . fromString $+                              case floatingOrInteger n of+                                  Left (r :: Double)   -> show r+                                  Right (i :: Integer) -> show i+      Bool True   -> return $ SimpleVal $ fromText "true"+      Object o    -> MapVal . Context . M.fromList . H.toList <$>+                       mapM parseJSON o+      _           -> return NullVal +instance TemplateTarget a => ToJSON (Context a) where+  toJSON (Context m) = toJSON m++instance TemplateTarget a => ToJSON (Val a) where+  toJSON NullVal = Null+  toJSON (MapVal m) = toJSON m+  toJSON (ListVal xs) = toJSON xs+  toJSON (SimpleVal t) = toJSON $ toText t+ multiLookup :: [Text] -> Val a -> Val a multiLookup [] x = x multiLookup (v:vs) (MapVal (Context o)) =@@ -211,7 +288,7 @@  -- | Render a compiled template in a "context" which provides -- values for the template's variables.-renderTemplate :: (TemplateTarget a, ToContext b a)+renderTemplate :: (TemplateTarget a, ToContext a b)                => Template -> b -> a renderTemplate t = renderTemp t . toContext 

@@ -0,0 +1,16 @@+{ "employee":+  [ { "name": { "first": "John", "last": "Doe" } }+  , { "name": { "first": "Omar", "last": "Smith" }+    , "salary": "" }+  , { "name": { "first": "Sara", "last": "Chen" }+    , "salary": [] }+  ]+}+.+$for(employee)$+Hi, $employee.name.first$. $if(employee.salary)$You make $$$employee.salary$.$else$No salary data.$endif$+$ endfor $+.+Hi, John. No salary data.+Hi, Omar. No salary data.+Hi, Sara. No salary data.

@@ -11,10 +11,10 @@ import System.FilePath import System.IO.Temp import Data.Aeson-import Control.Monad.Identity import System.FilePath.Glob import qualified Data.ByteString.Lazy as BL import Data.Semigroup ((<>))+import Data.Maybe  main :: IO () main = withTempDirectory "test" "out." $ \tmpdir -> do@@ -54,12 +54,16 @@   let actual = tmpdir </> takeFileName fp   return $ goldenVsFileDiff fp diff fp actual $ do     inp <- T.readFile fp-    let [json', template', _expected] = T.splitOn "\n.\n" inp-    let json = json' <> "\n"+    let (j, template', _expected) =+            case T.splitOn "\n.\n" inp of+              [x,y,z] -> (x,y,z)+              _       -> error $ "Error parsing " ++ fp+    let j' = j <> "\n"     let template = template' <> "\n"     let templatePath = replaceExtension fp ".txt"-    let Just (context :: Value) = decode' . BL.fromStrict . T.encodeUtf8 $ json+    let (context :: Value) = fromMaybe Null $+           decode' . BL.fromStrict . T.encodeUtf8 $ j'     res <- applyTemplate templatePath template context     case res of       Left e -> error e-      Right x -> T.writeFile actual $ json <> ".\n" <> template <> ".\n" <> x+      Right x -> T.writeFile actual $ j' <> ".\n" <> template <> ".\n" <> x