From 11f3691722ff5062f749c59349b1c4107afb01d1 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Sat, 22 Apr 2017 12:27:06 -0600 Subject: [PATCH] Working on basic interpolation --- examples/env.yaml | 5 ++++ examples/templates/simple.md | 18 +++++++------- plated.cabal | 7 ++++++ src/Plated/Command.hs | 6 ++--- src/Plated/Parser.hs | 29 ++++++---------------- src/Plated/Template.hs | 11 ++------- src/Plated/Yaml.hs | 48 ++++++++++++++++++++++++++++++++++++ 7 files changed, 81 insertions(+), 43 deletions(-) create mode 100644 examples/env.yaml create mode 100644 src/Plated/Yaml.hs diff --git a/examples/env.yaml b/examples/env.yaml new file mode 100644 index 0000000..0764474 --- /dev/null +++ b/examples/env.yaml @@ -0,0 +1,5 @@ +env: + date: $ date + title: Testing Templating + +output: ./dist diff --git a/examples/templates/simple.md b/examples/templates/simple.md index df9ffd2..9fd37e4 100755 --- a/examples/templates/simple.md +++ b/examples/templates/simple.md @@ -1,12 +1,12 @@ #!/Users/chris/.local/bin/plated-exe -This is normal Text -{{[[ tr 'a-z' 'A-Z' ]] -Testing and stuff -}} -more text -{{[[ cat ./lorem.md - ]] -the inner text +{{cat | tr 'a-z' 'A-Z' <= 4.7 && < 5 , text , parsec , process + , yaml + , containers + , aeson + , data-default + , filepath + , directory default-language: Haskell2010 executable plated-exe diff --git a/src/Plated/Command.hs b/src/Plated/Command.hs index 65b2706..e1ada2f 100644 --- a/src/Plated/Command.hs +++ b/src/Plated/Command.hs @@ -10,9 +10,9 @@ data Command = Command T.Text deriving Show -interpCommand :: T.Text -> Command -> IO T.Text -interpCommand inp (Command cmd) = do - (_, out, _) <- readCreateProcessWithExitCode (shell $ T.unpack cmd) (T.unpack inp) +interpCommand :: Command -> IO T.Text +interpCommand (Command cmd) = do + (_, out, _) <- readCreateProcessWithExitCode (shell $ T.unpack cmd) "" return . T.pack $ out diff --git a/src/Plated/Parser.hs b/src/Plated/Parser.hs index a6a8ac1..ff73cb9 100644 --- a/src/Plated/Parser.hs +++ b/src/Plated/Parser.hs @@ -1,7 +1,6 @@ {-# language OverloadedStrings #-} module Plated.Parser ( templateFromFile - , interpolate , shebang ) where @@ -21,43 +20,29 @@ infix 0 ?> (?>) :: String -> ParsecT s u m a -> ParsecT s u m a (?>) = flip () -templateFromFile :: FilePath -> IO (Either ParseError (Template Directive)) +templateFromFile :: FilePath -> IO (Either ParseError (Template Command)) templateFromFile fname = do file <- TIO.readFile fname return $ runP templateParser () fname file -templateParser :: Parser (Template Directive) +templateParser :: Parser (Template Command) templateParser = do optional shebang tmp <- template eof return tmp -template :: Parser (Template Directive) -template = Template <$> many (dir <|> txt) +template :: Parser (Template Command) +template = Template <$> many (cmd <|> txt) where - dir = Right <$> directive + cmd = Right <$> command txt = Left . T.pack <$> many1 (notFollowedBy (string "{{") *> anyChar) shebang :: Parser String shebang = "she-bang" ?> liftA2 (++) (string "#!") (manyTill anyChar (char '\n')) -directive :: Parser Directive -directive = "Directive" ?> do - spaces - _ <- string "{{" - spaces - mCommand <- optionMaybe command - txt <- manyTill anyChar (string "}}") - optional newline - return $ Directive mCommand (T.pack txt) - command :: Parser Command command = do - _ <- string "[[" - cmdString <- manyTill anyChar (string "]]") - spaces + _ <- string "{{" + cmdString <- manyTill anyChar (string "}}") return $ Command (T.pack cmdString) - -interpolate :: Template Directive -> T.Text -interpolate = const "hi" diff --git a/src/Plated/Template.hs b/src/Plated/Template.hs index 7c47311..66fe77c 100644 --- a/src/Plated/Template.hs +++ b/src/Plated/Template.hs @@ -1,7 +1,6 @@ {-# language OverloadedStrings #-} module Plated.Template ( Template(..) - , Directive(..) , processTemplate ) where @@ -14,11 +13,5 @@ data Template a = Template [Either T.Text a] deriving Show -data Directive = - Directive (Maybe Command) T.Text - deriving Show - -processTemplate :: Template Directive -> IO T.Text -processTemplate (Template elems) = fold <$> mapM (either return fromDirective) elems - where - fromDirective (Directive mCmd txt) = maybe (return "") (interpCommand txt) mCmd +processTemplate :: Template Command -> IO T.Text +processTemplate (Template elems) = fold <$> mapM (either return interpCommand) elems diff --git a/src/Plated/Yaml.hs b/src/Plated/Yaml.hs new file mode 100644 index 0000000..17f8417 --- /dev/null +++ b/src/Plated/Yaml.hs @@ -0,0 +1,48 @@ +{-# language LambdaCase #-} +{-# language TemplateHaskell #-} +{-# language ViewPatterns #-} +module Plated.Yaml + ( PlatedOptions(..) + , optionsFromFilename + , recurseUp + ) where + +import Control.Monad + +import Data.Yaml as Y +import Data.Aeson.TH +import Data.Map as M +import Data.Default +import Data.List + + +import System.FilePath +-- import System.Directory +import System.Exit + +data PlatedOptions = PlatedOptions + { _env :: Map String String + , _output :: String + } deriving Show + +instance Default PlatedOptions where + def = PlatedOptions M.empty "./" + +-- Derive toJSON, fromJSON +$(deriveJSON defaultOptions{fieldLabelModifier=drop 1} ''PlatedOptions) + +-- Retrieve an options object from a yaml file +optionsFromFilename :: FilePath -> IO PlatedOptions +optionsFromFilename = Y.decodeFileEither >=> + \case + Left err -> die . prettyPrintParseException $ err + Right options -> return options + +-- findProjRootFrom :: FilePath -> IO (Maybe FilePath) +-- findProjRootFrom (makeAbsolute -> fpath) = return . pure $ fpath + +recurseUp :: FilePath -> [FilePath] +recurseUp = unfoldr go + where + go "/" = Nothing + go path = Just (takeDirectory path, takeDirectory path)