Option Vars and Timestamp Date

app/Main.hs

@@ -18,25 +18,14 @@ import System.Exit (exitWith, ExitCode(..))
 import Data.List (intercalate)
 import Data.Char (isSpace)
 
-shift n = take (n*2) $ repeat ' '
-indentBy n = unlines . fmap (shift n ++) . lines
-
-wrapRules r = intercalate "\n" 
-  [ "service cloud.firestore {"
-  , "  match /databases/{database}/documents {"
-  , ""
-  , indentBy 2 r
-  , "  }"
-  , "}"
-  ]
 
 out output (Left e) = hPutStrLn stderr e
 out output (Right v) = output v
 
 generate lang
   | lang == "typescript" = TSGenerator.generate
   | lang == "ts" = TSGenerator.generate
-  | lang == "rules" = fmap wrapRules . RuleGenerator.generate 
+  | lang == "rules" = RuleGenerator.generate True
   | otherwise = const . Left $ 
       "Specified language \""++lang++"\"not recognized."
 

examples/readme.ward

@@ -1,3 +1,5 @@
+rules_version = '2'
+
 type User = {
   name: { first: string, last: string }, // inline nested objects
   friends: string[], // a list of strings (string type not validated)
@@ -18,5 +20,5 @@ function isLoggedInUser(userId) {
 match /users/{userId} is User { 
   // read, write, create, update, list, get and delete conditions are allowed
   allow read, create, update: if isLoggedInUser(userId);
-  allow delete: false;
+  allow delete: isLoggedInUser('admin');
 }

fireward.cabal

@@ -47,7 +47,15 @@ test-suite fireward-test
                      , fireward
                      , hspec
                      , QuickCheck
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wno-missing-home-modules
+  other-modules:      ExprParserSpec
+                    , LocSpec
+                    , LogicPrinterSpec
+                    , OptionParserSpec
+                    , ParserSpec
+                    , RuleGeneratorSpec
+                    , RuleParserSpec
+                    , TSGeneratorSpec
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N 
   default-language:    Haskell2010
 
 source-repository head

readme.md

@@ -82,6 +82,8 @@ match /users/{id} is User {
 ### Complete Example
 
 ```
+rules_version = '2' // optional, see https://firebase.google.com/docs/firestore/security/get-started#security_rules_version_2
+
 type User = {
   name: { first: string, last: string }, // inline nested objects
   friends: string[], // a list of strings (string type not validated)

src/RuleGenerator.hs

@@ -38,15 +38,21 @@ surround b e s = concat [b,s,e]
 printLoc l c = "line " ++ show (l+1) ++", column "++show (c+1)
 
 -- the main exported function. calls the `gen` function internally.
-generate :: String -> Either String String
-generate source = q tree
+generate :: Bool -> String -> Either String String
+generate wrap source = q tree
   where
+    finalize :: [TopLevel] -> [String] -> String
+    finalize tops lines = joinLines $ if wrap then optVars tops ++ wrapRules lines else lines
+    optVar (TopLevelOpt name val) = name ++ " = " ++ val ++ ";"
+    optVar _ = ""
+    optVars tops = optVar <$> tops 
     tree :: ParserResult [TopLevel]-- [([TopLevel], String)]
     tree = parseRules source
     q :: ParserResult [TopLevel] -> Either String String
-    q (Right (tops, unparsed, l, c)) = if length unparsed > 0
-                                          then Left ("Could not parse on\n  on " ++ printLoc l c)
-                                          else Right . trim . joinLines $ gen <$> tops
+    q (Right (tops, unparsed, l, c)) = 
+      if length unparsed > 0
+         then Left ("Could not parse on\n  on " ++ printLoc l c)
+         else Right . finalize tops $ gen <$> tops
     q (Left (Just (error, l, c))) = Left (error ++ "\n  on " ++ printLoc l c)
     q (Left Nothing) = Left ("Unexpected parser error.")
 
@@ -60,6 +66,22 @@ funcBlock ind (FuncDef name params body) = concat
     body' = trim . unlines $ (indent (ind + 2) ++) <$> lines body
 
 
+wrapRules :: [String] -> [String]
+wrapRules r = 
+  [ "service cloud.firestore {"
+  , "  match /databases/{database}/documents {"
+  , ""
+  ]
+  ++ indented ++
+  [ ""
+  , "  }"
+  , "}"
+  ]
+  where 
+    indented = indentLinesBy2 r :: [String]
+    indentLinesBy2 = fmap (shift 2 ++)
+    shift n = take (n*2) $ repeat ' '
+
 data FuncParam = FuncParam (Maybe String) String
 -- the main recursive function to generate the type function
 typeFunc :: String -> [TypeRef] -> String
@@ -144,6 +166,7 @@ typeFunc name refs =
 
 
 gen :: TopLevel -> String
+gen (TopLevelOpt name val) = "" -- this will be generated after wrapping the code
 gen (TopLevelFunc def) = funcBlock 0 def
 gen (TopLevelType name refs) = typeFunc name refs
 gen (TopLevelPath def) = pathBlock 0 def

src/RuleParser.hs

@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
 module RuleParser 
 ( parseRules
 , apply
@@ -13,6 +12,7 @@ module RuleParser
 , _funcDef
 , _funcBody
 , _string
+, _topLevelOptVar
 , escape
 , FuncDef (..)
 , TypeDef (..)
@@ -34,6 +34,7 @@ import Combinators
 data TopLevel = TopLevelType String [TypeRef]
               | TopLevelPath PathDef
               | TopLevelFunc FuncDef
+              | TopLevelOpt String String
   deriving (Show, Eq)
 
 type PathOp = String
@@ -71,6 +72,16 @@ data Field = Field
 - str = "(all - {"})*"
 -}
 
+_topLevelOptVar = do
+  name <- token _var
+  symbol "="
+  optional space
+  val <- require "configuration option value is not provided" $ _string <|> some digit
+  optional space
+  optional $ symbol ";"
+  return $ TopLevelOpt name val
+  where _var = _concat [ some $ _alpha <|> oneOf "_", many $ _alphaNum <|> oneOf "_" ] ""
+
 _funcBody :: Parser String
 _funcBody = token $ do
   let notDone c = c/='}' && c/=';' && c/='"'
@@ -202,7 +213,8 @@ _path = do
   require "expected a closing `}`" $ symbol "}"
   return  $ PathDef parts className body
 
-_topLevel = (TopLevelPath <$> _path) 
+_topLevel = _topLevelOptVar
+        <|> (TopLevelPath <$> _path) 
         <|> _topLevelType 
         <|> TopLevelFunc <$> _funcDef
 

src/TSGenerator.hs

@@ -35,7 +35,7 @@ block ind items = joinLines
 natives = 
   [ ("int", "number")
   , ("float", "number")
-  , ("timestamp", "{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}")
+  , ("timestamp", "Date|{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}")
   , ("bool", "boolean")
   , ("null", "null")
   ]

test/RuleGeneratorSpec.hs

@@ -28,7 +28,7 @@ showN = repA . show
 showE (Right x) = "Right " ++ repA x
 showE (Left x) = "Left " ++ repA x
 -- showE (Left Nothing) = "Left Nothing"
-g = showE . RuleGenerator.generate
+g = showE . RuleGenerator.generate False
 gt z = (\x->trace (showN x) x) (g z)
 gu = g . trim . unlines
 r = ("Right " ++) . repA

test/RuleParserSpec.hs

@@ -238,5 +238,9 @@ spec = do
           PathBodyFunc (FuncDef "qqq" ["a","b","c"] "123")])
         ])
       ],"")
+  describe "_topLevelOptVar" $ do
+    it "parses" $
+      _parse "fff = '2'" `shouldBe` Right ([ TopLevelOpt "fff" "'2'"], "")
+
 
 

test/TSGeneratorSpec.hs

@@ -29,7 +29,7 @@ gt z = (\x->trace (showN x) x) (g z)
 gu = g . trim . unlines
 r = ("Right " ++) . repA
 ru = r . trim . unlines
-timestamp = "{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}"
+timestamp = "Date|{seconds: number, nanoseconds: number}|{isEqual: (other: any)=>boolean}"
 
 
 spec :: Spec