hamlet-0.7.0: Old/Julius.hs
module Old.Julius
( render
, parse
) where
import qualified Text.ParserCombinators.Parsec as P
import Text.ParserCombinators.Parsec hiding (Line, parse)
import Data.Char (isUpper, isDigit)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.Monoid
import System.IO.Unsafe (unsafePerformIO)
import Old.Utf8
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Text.Shakespeare (Deref (..), Ident (..))
import Text.Julius (Content (..), Contents)
parse s = either (error . show) id $ P.parse parseContents s s
render = concatMap render'
render' (ContentRaw s) = s
render' (ContentVar deref) = concat [ "#{", renderDeref deref, "}" ]
render' (ContentUrl deref) = concat [ "@{", renderDeref deref, "}" ]
render' (ContentUrlParam deref) = concat [ "@?{", renderDeref deref, "}" ]
render' (ContentMix deref) = concat [ "^{", renderDeref deref, "}" ]
parseContents :: Parser Contents
parseContents = many1 parseContent
parseContent :: Parser Content
parseContent = do
(char '%' >> (parsePercent <|> parseVar)) <|>
(char '@' >> (parseAt <|> parseUrl)) <|> do
(char '^' >> (parseCaret <|> parseMix)) <|> do
s <- many1 $ noneOf "%@^"
return $ ContentRaw s
where
parseCaret = char '^' >> return (ContentRaw "^")
parseMix = do
d <- parseDeref
_ <- char '^'
return $ ContentMix d
parseAt = char '@' >> return (ContentRaw "@")
parseUrl = do
c <- (char '?' >> return ContentUrlParam) <|> return ContentUrl
d <- parseDeref
_ <- char '@'
return $ c d
parsePercent = char '%' >> return (ContentRaw "%")
parseVar = do
d <- parseDeref
_ <- char '%'
return $ ContentVar d
parseDeref :: Parser Deref
parseDeref =
deref
where
derefParens = between (char '(') (char ')') deref
derefSingle = derefParens <|> fmap (DerefIdent . Ident) ident
deref = do
let delim = (char '.' <|> (many1 (char ' ') >> return ' '))
x <- derefSingle
xs <- many $ delim >> derefSingle
return $ foldr1 DerefBranch $ x : xs
ident = many1 (alphaNum <|> char '_' <|> char '\'')