Initial parsing working

This commit is contained in:
Chris Penner 2017-04-20 18:02:59 -06:00
parent 46e54d52c3
commit 258d9cb027
8 changed files with 135 additions and 9 deletions

1
.gitignore vendored Normal file

@ -0,0 +1 @@
/.stack-work

@ -1,6 +1,20 @@
module Main where
import Lib
import System.Environment
import System.Exit
import Data.Foldable
import Data.Either
import Control.Monad
import qualified Data.Text.IO as TIO
import Plated.Parser
import Plated.Template
main :: IO ()
main = someFunc
main = do
filenames <- getArgs
templates <- traverse templateFromFile filenames
when (not . null $ lefts templates) $
print (lefts templates) >> exitFailure
traverse_ (processTemplate >=> TIO.putStr) (rights templates)

@ -0,0 +1,12 @@
#!/bin/plated
{{ value }}
This is normal Text
{{[[ $this | tr 'a-z' 'A-Z' ]]
Testing and stuff
}}
more text
{{ value }}{{ value }}

@ -15,8 +15,13 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Lib
exposed-modules: Plated.Template
, Plated.Parser
, Plated.Command
build-depends: base >= 4.7 && < 5
, text
, parsec
, process
default-language: Haskell2010
executable plated-exe
@ -25,6 +30,7 @@ executable plated-exe
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, plated
, text
default-language: Haskell2010
test-suite plated-test

@ -1,6 +0,0 @@
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"

17
src/Plated/Command.hs Normal file

@ -0,0 +1,17 @@
module Plated.Command
( Command(..)
, interpCommand
) where
import System.Process
import qualified Data.Text as T
data Command =
Command T.Text
deriving Show
interpCommand :: Command -> IO T.Text
interpCommand (Command cmd) = do
(_, out, _) <- readCreateProcessWithExitCode (shell $ T.unpack cmd) ""
return . T.pack $ out

60
src/Plated/Parser.hs Normal file

@ -0,0 +1,60 @@
{-# language OverloadedStrings #-}
module Plated.Parser
( templateFromFile
, interpolate
, shebang
) where
import Plated.Template
import Plated.Command
import Data.Text.IO as TIO
import qualified Data.Text as T
import Control.Applicative (liftA2)
import Text.Parsec
import Text.Parsec.Text
infix 0 ?>
(?>) :: String -> ParsecT s u m a -> ParsecT s u m a
(?>) = flip (<?>)
templateFromFile :: FilePath -> IO (Either ParseError (Template Directive))
templateFromFile fname = do
file <- TIO.readFile fname
return $ runP templateParser () fname file
templateParser :: Parser (Template Directive)
templateParser = do
tmp <- template
optional shebang
eof
return tmp
template :: Parser (Template Directive)
template = Template <$> many (dir <|> txt)
where
dir = Right <$> directive
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
_ <- string "{{"
spaces
mCommand <- optionMaybe cmd
txt <- manyTill anyChar (string "}}")
return $ Directive mCommand (T.pack txt)
cmd :: Parser Command
cmd = do
_ <- string "[["
cmdString <- manyTill anyChar (string "]]")
return $ Command (T.pack cmdString)
interpolate :: Template Directive -> T.Text
interpolate = const "hi"

22
src/Plated/Template.hs Normal file

@ -0,0 +1,22 @@
module Plated.Template
( Template(..)
, Directive(..)
, processTemplate
) where
import Plated.Command
import qualified Data.Text as T
data Template a =
Template [Either T.Text a]
deriving Show
data Directive =
Directive (Maybe Command) T.Text
deriving Show
processTemplate :: Template Directive -> T.Text
processTemplate (Template elems) = foldMap (either id fromDirective) elems
where
fromDirective (Directive _ txt) = txt