Permalink
Browse files

Holy fuck this is bad

  • Loading branch information...
1 parent 0dfb10e commit 0ee8691cc088744f71c47fdb964e8a743d378bce @xldenis committed Feb 17, 2017
Showing with 336 additions and 122 deletions.
  1. +2 −0 .ghci
  2. +6 −1 app/Main.hs
  3. +7 −1 hliquid.cabal
  4. +28 −0 src/HLiquid/Lexer.hs
  5. +136 −41 src/HLiquid/Parser.hs
  6. +26 −0 src/HLiquid/Parser/Variable.hs
  7. +54 −40 src/HLiquid/Syntax.hs
  8. +16 −5 src/Lib.hs
  9. +1 −2 stack.yaml
  10. +1 −0 test.liquid
  11. +57 −26 test/Expectation.hs
  12. +2 −6 test/HLiquid/ParserSpec.hs
View
@@ -0,0 +1,2 @@
+:set -XOverloadedStrings
+:i Text.Megaparsec
View
@@ -1,6 +1,11 @@
module Main where
import Lib
+import HLiquid.Parser
+
+import System.Environment
main :: IO ()
-main = someFunc
+main = do
+ files <- getArgs
+ mapM_ (\file -> parseFile fullFile file) files
View
@@ -18,12 +18,14 @@ library
exposed-modules: Lib
, HLiquid.Syntax
, HLiquid.Parser
+ , HLiquid.Parser.Variable
+ other-modules: HLiquid.Lexer
build-depends: base >= 4.7 && < 5
, text
, megaparsec
default-language: Haskell2010
-executable hliquid-exe
+executable hliquid
hs-source-dirs: app
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
@@ -42,6 +44,10 @@ test-suite hliquid-test
, megaparsec
, QuickCheck
, text
+ , directory
+ , filepath
+ , hspec-megaparsec
+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
View
@@ -0,0 +1,28 @@
+module HLiquid.Lexer where
+
+import Control.Monad
+
+import qualified Text.Megaparsec.Lexer as L
+import Text.Megaparsec.Text
+import Text.Megaparsec
+
+import Control.Applicative (empty)
+import Control.Monad (void, join)
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme sc
+
+symbol :: String -> Parser String
+symbol = L.symbol' sc
+
+sc :: Parser ()
+sc = L.space (void spaceChar) empty empty
+
+tag :: Parser a -> Parser a
+tag = between (symbol "{{") (symbol "}}")
+
+tag' :: Parser a -> Parser a
+tag' = between (symbol "{%") (symbol "%}")
+
+placeHolder :: Parser String
+placeHolder = someTill anyChar (lookAhead $ string "%}")
View
@@ -1,48 +1,143 @@
{-# LANGUAGE OverloadedStrings #-}
module HLiquid.Parser where
-import Prelude hiding (lex)
+import Text.Megaparsec
+import Text.Megaparsec.Text
-import qualified Data.Text as T
+import Data.Text (pack)
+import Data.Maybe (maybeToList)
+import HLiquid.Lexer
import HLiquid.Syntax
-import Text.Megaparsec
-import Text.Megaparsec.Text
-import qualified Text.Megaparsec.Lexer as L
-import Text.Megaparsec.Char
-
-lex = L.lexeme space
-
-retBlock :: Parser Liquid
-retBlock = do
- lex $ string "{%"
- exp <- expression
- lex $ string "%}"
- return $ ReturnBlock exp
-
-block :: Parser Liquid
-block = do
- lex $ string "{{"
- exp <- expression
- lex $ string "}}"
- return $ Block exp
-
-markup :: Parser Liquid
-markup = do
- text <- T.pack <$> manyTill anyChar blockOpen
- return $ HTML text
-
-blockOpen :: Parser ()
-blockOpen = (try $ string "{{") <|> string "{%" >> return ()
-
-blockClose :: Parser ()
-blockClose = (try $ string "}}") <|> (try $ string "%}") >> return ()
-
-expression :: Parser Expression
-expression = do
- body <- manyTill word (lookAhead blockClose)
- return $ Expression body
- where word = T.pack <$> (lex . many $ noneOf "%} ")
-
-html = undefined
+import HLiquid.Parser.Variable
+
+fullFile = many liquid <* eof
+
+liquid :: Parser Expression
+liquid = ifTag
+ <|> unlessTag
+ <|> caseTag
+ <|> formTag
+ <|> forTag
+ <|> tablerowTag
+ <|> breakTag
+ <|> continueTag
+ <|> cycleTag
+ <|> layoutTag
+ <|> commentTag
+ <|> expressionTag
+ <|> assignTag
+ <|> captureTag liquid
+ <|> paginateTag
+ <|> bodyText
+
+ifTag :: Parser Expression
+ifTag = do
+ b1 <- branch "if"
+
+ branches <- many $ branch "elsif"
+
+ e <- optional . try $ do
+ tag' $ symbol "else"
+ b <- many liquid
+ return $ Else b
+
+ tag' $ symbol "endif"
+ return . If $ b1 : (branches ++ maybeToList e)
+
+ where branch nm = do
+ cond <- try . tag' $ symbol nm *> placeHolder
+ body <- many $ liquid
+ return $ Branch Filter body
+
+unlessTag :: Parser Expression
+unlessTag = do
+ b1 <- branch "unless"
+
+ branches <- many $ branch "elsif"
+
+ e <- optional . try $ do
+ tag' $ symbol "else"
+ b <- many liquid
+ return $ Else b
+
+ tag' $ symbol "endunless"
+ return . If $ b1 : (branches ++ maybeToList e)
+
+ where branch nm = do
+ cond <- try . tag' $ symbol nm *> placeHolder
+ body <- many $ liquid
+ return $ Branch Filter body
+
+caseTag :: Parser Expression
+caseTag = try $ do
+ tag' $ symbol "case"
+ body <- some $ (tag' $ symbol "when") >> When <$> many liquid
+ tag' $ symbol "endcase"
+
+ return $ Case body
+
+forTag :: Parser Expression
+forTag = do
+ try . tag' $ symbol "for" *> placeHolder
+ b <- many $ liquid
+ tag' $ symbol "endfor"
+ return $ For Form b
+
+tablerowTag :: Parser Expression
+tablerowTag = try $ do
+ tag' $ symbol "tablerow"
+ b <- many $ liquid
+ tag' $ symbol "endtablerow"
+
+ return $ Tablerow
+
+breakTag :: Parser Expression
+breakTag = try . tag' $ symbol "break" *> pure Break
+
+continueTag :: Parser Expression
+continueTag = try . tag' $ symbol "continue" *> pure Continue
+
+cycleTag :: Parser Expression
+cycleTag = try . tag' $ symbol "cycle" *> placeHolder *> pure (Cycle [])
+
+layoutTag :: Parser Expression
+layoutTag = try . tag' $ do
+ symbol "layout"
+ placeHolder
+ pure Layout
+
+formTag :: Parser Expression
+formTag = do
+ try . tag' $ symbol "form" *> placeHolder
+ b <- many $ liquid
+ tag' $ symbol "endform"
+
+ return $ Form
+
+paginateTag :: Parser Expression
+paginateTag = do
+ try . tag' $ symbol "paginate" *> placeHolder
+ b <- many $ liquid
+ tag' $ symbol "endpaginate"
+
+ return $ Paginate
+
+commentTag :: Parser Expression
+commentTag = do
+ try . tag' $ symbol "comment"
+ many $ liquid
+ try . tag' $ symbol "endcomment"
+ return $ Comment
+
+expressionTag :: Parser Expression
+expressionTag = try . tag $ do
+ many $ noneOf ['}']
+ return $ Expression []
+
+bodyText :: Parser Expression
+bodyText = LitString . pack <$> do
+ notFollowedBy openB
+ someTill anyChar $ lookAhead openB
+ where openB = (string "{{" <|> string "{%" <|> eof *> pure "e")
@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+module HLiquid.Parser.Variable where
+
+import HLiquid.Syntax
+
+import Text.Megaparsec
+import Text.Megaparsec.Text
+
+import HLiquid.Lexer
+
+assignTag :: Parser Expression
+assignTag = try . tag' $ do
+ symbol "assign"
+ placeHolder
+ return $ Assign "" ""
+
+-- incrementTag :: Parser Expression
+
+-- decrementTag :: Parser Expression
+
+captureTag :: Parser Expression -> Parser Expression
+captureTag e = do
+ try . tag' $ symbol "capture" *> placeHolder
+ many e
+ tag' $ symbol "endcapture"
+ return $ Capture
View
@@ -1,45 +1,59 @@
module HLiquid.Syntax where
- import Data.Text
+import Data.Text
- data Liquid
- = HTML Text
- | ReturnBlock Expression
- | Block Expression
- deriving (Eq, Show)
+data Liquid
+ = HTML Text
+ | ReturnBlock Expression
+ | Block Expression
+ deriving (Eq, Show)
- data Expression
- = Expression [Text] -- Temporary Expand to actual expressions later
- | If -- unless and elseif
- | Case
- -- Loop Tags
- | For
- | Break
- | Continue
- | Cycle
- | Tablerow
- -- Layout Tag
- | Comment
- | Include
- | Form
- | Layout
- | Paginate
- | Raw
- -- Variable Tag
- | Assign
- | Capture
- | Increment
- | Decrement
- -- Filters
- | Filter
- deriving (Eq, Show)
+data When
+ = When [Expression]
+ deriving (Eq, Show)
+data Branch
+ = Branch Expression [Expression]
+ | Else [Expression]
+ deriving (Eq, Show)
+data Expression
+ = Expression [Text] -- Temporary Expand to actual expressions later
+ | If [Branch] -- unless and elseif
+ | Case [When]
+ -- Loop Tags
+ | For Expression [Expression]
+ | Break
+ | Continue
+ | Cycle [Expression]
+ | Tablerow
+ -- Layout Tag
+ | Comment
+ | Include Text
+ | Form
+ | Layout
+ | Paginate
+ | Raw
+ -- Variable Tag
+ | Assign Text Text
+ | Capture -- TODO
+ | Increment Expression
+ | Decrement Expression
+ | Variable Text
+ | Handle Expression Text
+ -- Filters
+ | Filter
+ -- Types
+ | LitString Text
- data Operator
- = Equal
- | NotEqual
- | Greater
- | Less
- | GreaterEq
- | LessEq
- | Or
- | And
+ -- Shopify :(
+ -- | Form
+ deriving (Eq, Show)
+
+data Operator
+ = Equal
+ | NotEqual
+ | Greater
+ | Less
+ | GreaterEq
+ | LessEq
+ | Or
+ | And
Oops, something went wrong.

0 comments on commit 0ee8691

Please sign in to comment.