Parsing Page - name, route and content. (#18)

stic/package.yaml

@@ -81,3 +81,4 @@ tests:
       - tasty-quickcheck
       - tasty-discover
       - QuickCheck
+      - parsec

stic/src/Lexer.hs

@@ -8,10 +8,13 @@ import qualified Text.Parsec.Token as Token
 reservedNameApp :: String
 reservedNameApp = "app"
 
+reservedNamePage :: String
+reservedNamePage = "page"
+
 waspLanguageDef :: Token.LanguageDef ()
 waspLanguageDef = emptyDef 
     { Token.commentLine = "//"
-    , Token.reservedNames = [reservedNameApp]
+    , Token.reservedNames = [reservedNameApp, reservedNamePage]
     , Token.caseSensitive = True
     -- Identifier
     , Token.identStart = letter

stic/src/Parser.hs

@@ -2,13 +2,23 @@ module Parser
     ( parseWasp
     ) where
 
-import Text.Parsec (parse, ParseError)
+import Text.Parsec (parse, ParseError, (<|>), many1, eof)
 import Text.Parsec.String (Parser)
 
 import Lexer
-import Parser.App
+import Parser.App (app)
+import Parser.Page (page)
+import Parser.Common (runWaspParser)
 import qualified Wasp
 
+waspElement :: Parser Wasp.WaspElement
+waspElement = waspElementApp <|> waspElementPage
+
+waspElementApp :: Parser Wasp.WaspElement
+waspElementApp = Wasp.WaspElementApp <$> app
+
+waspElementPage :: Parser Wasp.WaspElement
+waspElementPage = Wasp.WaspElementPage <$> page
 
 -- | Top level parser, produces Wasp.
 waspParser :: Parser Wasp.Wasp
@@ -18,25 +28,14 @@ waspParser = do
     -- so they do it themselves.
     whiteSpace
 
-    -- TODO(matija): extract this into a single parser.
-    reserved reservedNameApp
-    parsedAppName <- identifier
-    parsedAppProperties <- braces $ appProperties
-
+    waspElems <- many1 waspElement
+    eof
+    
     -- TODO(matija): after we parsed everything, we should do semantic analysis
     -- e.g. check there is only 1 title - if not, throw a meaningful error.
 
-    return $ Wasp.fromApp $ Wasp.App
-        { Wasp.appName = parsedAppName
-        , Wasp.appTitle = getAppTitle parsedAppProperties
-          -- TODO(matija): add favicon.
-        }
+    return $ Wasp.fromWaspElems waspElems
 
 -- | Top level parser executor.
 parseWasp :: String -> Either ParseError Wasp.Wasp
-parseWasp wasp = parse waspParser sourceName wasp
-  where
-    -- NOTE(matija): this is used by Parsec only when reporting errors, but we currently
-    -- don't provide source name (e.g. .wasp file name) to this method so leaving it empty
-    -- for now.
-    sourceName = ""
+parseWasp input = runWaspParser waspParser input

stic/src/Parser/App.hs

@@ -1,14 +1,18 @@
-module Parser.App where
+module Parser.App
+    ( app
+    ) where
 
 import Text.Parsec
 import Text.Parsec.String (Parser)
 
 import Lexer
+import qualified Wasp
+import Parser.Common
 
 -- | A type that describes supported app properties.
 data AppProperty
-    = Title String
-    | Favicon String
+    = Title !String
+    | Favicon !String
     deriving (Show, Eq)
 
 -- | Parses supported app properties, expects format "key1: value1, key2: value2, ..."
@@ -16,16 +20,23 @@ appProperties :: Parser [AppProperty]
 appProperties = commaSep1 $ appPropertyTitle <|> appPropertyFavicon
 
 appPropertyTitle :: Parser AppProperty
-appPropertyTitle = Title <$> appPropertyWithKey "title"
+appPropertyTitle = Title <$> waspPropertyStringLiteral "title"
 
 appPropertyFavicon :: Parser AppProperty
 -- TODO(matija): 'fav.png' currently does not work because of '.'. Support it.
-appPropertyFavicon = Favicon <$> appPropertyWithKey "favicon"
-
--- | Helper function, parses a key/value pair. E.g. 'title: "Some title"'.
-appPropertyWithKey :: String -> Parser String
-appPropertyWithKey key = symbol key <* colon *> stringLiteral
+appPropertyFavicon = Favicon <$> waspPropertyStringLiteral "favicon"
 
 -- TODO(matija): unsafe, what if empty list?
 getAppTitle :: [AppProperty] -> String
 getAppTitle ps = head $ [t | Title t <- ps]
+
+-- | Top level parser, parses App.
+app :: Parser Wasp.App
+app = do
+    (appName, appProps) <- waspElementNameAndProps reservedNameApp appProperties
+
+    return Wasp.App 
+        { Wasp.appName = appName
+        , Wasp.appTitle = getAppTitle appProps
+          -- TODO(matija): add favicon.
+        }

stic/src/Parser/Common.hs

@@ -0,0 +1,56 @@
+{-
+   Common functions used among Wasp parsers.
+-}
+
+module Parser.Common where
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+import qualified Data.Text as T
+
+import Lexer
+
+-- | Runs given wasp parser on a specified input.
+runWaspParser :: Parser a -> String -> Either ParseError a
+runWaspParser waspParser input = parse waspParser sourceName input
+  where
+    -- NOTE(matija): this is used by Parsec only when reporting errors, but we currently
+    -- don't provide source name (e.g. .wasp file name) to this method so leaving it empty
+    -- for now.
+    sourceName = ""
+
+ -- | Parses a declaration of wasp element (e.g. App or Page) and its properties.
+waspElementNameAndProps
+    :: String -- ^ Type of the wasp element (e.g. "app" or "page").
+    -> Parser a -- ^ Parser to be used for parsing properties of the wasp element.
+    -> Parser (String, a) -- ^ Name of the element and parsed properties.
+waspElementNameAndProps elementType properties = do
+    -- TODO(matija): should we somehow check if this is a reserved name?
+    reserved elementType
+    elementName <- identifier
+    elementProperties <- braces properties
+
+    return (elementName, elementProperties)
+
+-- | Parses wasp property along with the key, "key: value".
+waspProperty :: String -> Parser a -> Parser a
+waspProperty key value = symbol key <* colon *> value
+
+-- | Parses wasp property which has a string literal for a value.
+-- e.g.: title: "my first app"
+waspPropertyStringLiteral :: String -> Parser String
+waspPropertyStringLiteral key = waspProperty key stringLiteral
+
+-- | Parses wasp property which has a clojure for a value. Returns content within the
+-- clojure.
+waspPropertyClosure :: String -> Parser String
+waspPropertyClosure key = waspProperty key waspClosure
+
+-- | Parses wasp clojure, which is {...}. Returns content within the clojure.
+-- NOTE(matija): currently it is not supported to have clojure within a clojure.
+waspClosure :: Parser String
+waspClosure = strip <$> (braces $ many $ noneOf "{}")
+
+-- | Removes leading and trailing spaces from a string.
+strip :: String -> String
+strip = T.unpack . T.strip . T.pack

stic/src/Parser/Page.hs

@@ -0,0 +1,52 @@
+module Parser.Page
+    ( page
+    ) where
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+
+import Lexer
+import qualified Wasp
+import Parser.Common
+
+data PageProperty
+    = Title !String
+    | Route !String
+    | Content !String
+    deriving (Show, Eq)
+
+-- | Parses Page properties, separated by a comma.
+pageProperties :: Parser [PageProperty]
+pageProperties = commaSep1 $
+    pagePropertyTitle
+    <|> pagePropertyRoute
+    <|> pagePropertyContent
+
+pagePropertyTitle :: Parser PageProperty
+pagePropertyTitle = Title <$> waspPropertyStringLiteral "title"
+
+pagePropertyRoute :: Parser PageProperty
+pagePropertyRoute = Route <$> waspPropertyStringLiteral "route"
+
+pagePropertyContent :: Parser PageProperty
+pagePropertyContent = Content <$> waspPropertyClosure "content"
+
+-- TODO(matija): unsafe, what if empty list?
+getPageRoute :: [PageProperty] -> String
+-- TODO(matija): we are repeating this pattern. How can we extract it? Consider using
+-- Template Haskell, lens and prism.
+getPageRoute ps = head $ [r | Route r <- ps]
+
+getPageContent :: [PageProperty] -> String
+getPageContent ps = head $ [c | Content c <- ps]
+
+-- | Top level parser, parses Page.
+page :: Parser Wasp.Page
+page = do
+    (pageName, pageProps) <- waspElementNameAndProps reservedNamePage pageProperties
+
+    return Wasp.Page
+        { Wasp.pageName = pageName
+        , Wasp.pageRoute = getPageRoute pageProps
+        , Wasp.pageContent = getPageContent pageProps
+        }

stic/src/Wasp.hs

@@ -1,10 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Wasp
     ( Wasp
+    , WaspElement (..)
     , App (..)
     , fromApp
+    , fromWaspElems
     , getApp
     , setApp
+    , Page (..)
     ) where
 
 import qualified Data.Aeson as Aeson
@@ -14,10 +17,12 @@ data Wasp = Wasp [WaspElement] deriving (Show, Eq)
 
 data WaspElement
     = WaspElementApp !App
-    | WaspElementPage
+    | WaspElementPage !Page
     | WaspElementEntity
     deriving (Show, Eq)
 
+-- App
+
 data App = App
     { appName :: !String -- Identifier
     , appTitle :: !String -- Title
@@ -45,7 +50,6 @@ setApp (Wasp elems) app = Wasp $ (WaspElementApp app) : (filter (not . isAppElem
 fromApp :: App -> Wasp
 fromApp app = Wasp [WaspElementApp app]
 
-
 -- NOTE(martin): Here I define general transformation of App into JSON that I can then easily use
 --   as data for templates, but we will probably want to replace this in the future with the better tailored
 --   types that are exact fit for what is neeed (for example one type per template).
@@ -58,3 +62,14 @@ instance Aeson.ToJSON Wasp where
     toJSON wasp = Aeson.object
         [ "app" Aeson..= getApp wasp
         ]
+
+fromWaspElems :: [WaspElement] -> Wasp
+fromWaspElems elems = Wasp elems
+
+-- Page
+
+data Page = Page
+    { pageName :: !String
+    , pageRoute :: !String
+    , pageContent :: !String
+    } deriving (Show, Eq)

stic/test/Parser/CommonTest.hs

@@ -0,0 +1,71 @@
+module Parser.CommonTest where
+
+import qualified Test.Tasty
+import Test.Tasty.Hspec
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+import Data.Either
+
+import Lexer
+import Parser.Common
+
+spec_parseWaspCommon :: Spec
+spec_parseWaspCommon = do
+    describe "Parsing wasp element name and properties" $ do
+        let parseWaspElementNameAndProps elemKeyword p input =
+                runWaspParser (waspElementNameAndProps elemKeyword p) input
+
+        it "When given valid wasp element declaration along with whitespace parser,\
+            \ returns an expected result" $ do
+            parseWaspElementNameAndProps "app" whiteSpace "app someApp { }"
+                `shouldBe` Right ("someApp", ())
+
+        it "When given valid wasp element declaration along with char parser, returns\
+            \ an expected result" $ do
+            parseWaspElementNameAndProps "app" (char 'a') "app someApp {a}"
+                `shouldBe` Right ("someApp", 'a')
+
+        it "When given wasp element declaration with invalid name, returns Left" $ do
+            (isLeft $ parseWaspElementNameAndProps "app" whiteSpace "app 1someApp { }")
+                `shouldBe` True
+
+    describe "Parsing wasp property - string literal" $ do
+        let parseWaspPropertyStringLiteral key input =
+                runWaspParser (waspPropertyStringLiteral key) input
+
+        it "When given key/value with int value, returns Left." $ do
+            isLeft (parseWaspPropertyStringLiteral "title" "title: 23")
+                `shouldBe` True
+
+        it "When given key/value with string value, returns a parsed value." $ do
+            let appTitle = "my first app"
+            parseWaspPropertyStringLiteral "title" ("title: \"" ++ appTitle ++ "\"")
+                `shouldBe` Right appTitle
+
+    describe "Parsing wasp property - closure {...}" $ do
+        let parseWaspPropertyClosure key input =
+                runWaspParser (waspPropertyClosure key) input
+
+        it "When given int, returns Left." $ do
+            isLeft (parseWaspPropertyClosure "content" "title: 23")
+                `shouldBe` True
+
+        it "When given content within braces, returns that content." $ do
+            parseWaspPropertyClosure "content" "content: {  some content   }"
+                `shouldBe` Right "some content"
+
+    describe "Parsing wasp closure" $ do
+        let parseWaspClosure input = runWaspParser waspClosure input
+        let closureContent = "<div>hello world</div>"
+    
+        it "Returns the content of closure" $ do
+            parseWaspClosure ("{ " ++ closureContent ++ " }")
+                `shouldBe` Right closureContent
+
+        it "Removes leading and trailing spaces" $ do
+            parseWaspClosure ("{   " ++  closureContent ++ "   }")
+                `shouldBe` Right closureContent
+
+    
+

stic/test/Parser/PageTest.hs

@@ -0,0 +1,35 @@
+module Parser.PageTest where
+
+import qualified Test.Tasty
+import Test.Tasty.Hspec
+
+import Data.Either
+import Text.Parsec
+
+import Parser.Page
+import Wasp
+
+-- | Page parser executor.
+parsePage :: String -> Either ParseError Wasp.Page
+parsePage pageWasp = parse page "" pageWasp
+
+spec_parsePage :: Spec
+spec_parsePage =
+    describe "Parsing page wasp" $ do
+        it "When given valid page wasp declaration, returns correct Wasp.Page" $ do
+            let testPageName = "Landing"
+            let testPageRoute = "/someRoute"
+            let testPageContent = "<span/>"
+            parsePage (
+                "page " ++ testPageName ++ " { " ++
+                    "route: \"" ++ testPageRoute ++ "\"," ++ 
+                    "content: { " ++ testPageContent ++ " }" ++ 
+                "}")
+                `shouldBe` Right (Page
+                    { pageName = testPageName
+                    , pageRoute = testPageRoute
+                    , pageContent = testPageContent
+                    })
+
+        it "When given page wasp declaration without 'page', should return Left" $ do
+            isLeft (parsePage "Landing { route: someRoute })") `shouldBe` True

stic/test/Parser/ParserTest.hs

@@ -14,11 +14,19 @@ spec_parseWasp =
             isLeft (parseWasp "hoho") `shouldBe` True
 
         before (readFile "test/Parser/valid.wasp") $ do
-            it "When given a valid wasp with app and name, should return correct \
+            it "When given a valid wasp with app and name, should return correct\
                 \ Wasp" $ \wasp -> do
                 parseWasp wasp
                 `shouldBe`
-                Right (fromApp $ App
-                { appName = "test_app"
-                , appTitle = "Hello World!"
-                })
+                Right (fromWaspElems
+                    [ WaspElementApp $ App
+                        { appName = "test_app"
+                        , appTitle = "Hello World!"
+                        }
+                    , WaspElementPage $ Page
+                        { pageName = "Landing"
+                        , pageRoute = "/home"
+                        , pageContent = "<div>My landing page!</div>"
+                        }
+                    ]
+                )

stic/test/Parser/valid.wasp

@@ -1,6 +1,15 @@
 // Test .wasp file.
 
+// App definition.
 app test_app {
     // Title of the app.
     title: "Hello World!"
 }
+
+// Page definition.
+page Landing {
+    route: "/home",
+    content: {
+        <div>My landing page!</div>
+    }
+}