persistent-parser 0.1.0.0 → 0.1.0.1
raw patch · 3 files changed
+251/−1 lines, 3 files
Files
- ChangeLog.md +4/−0
- persistent-parser.cabal +2/−1
- tests/Database/Persist/ParserSpec.hs +245/−0
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for persistent-parser +## 0.1.0.1 -- 2016-09-08++* Add test files to other-modules so sdist will package them in the tar.gz.+ ## 0.1.0.0 -- 2016-09-08 * Parse persistent files into a syntax tree.
persistent-parser.cabal view
@@ -1,5 +1,5 @@ name: persistent-parser-version: 0.1.0.0+version: 0.1.0.1 synopsis: Parse persistent model files description: Parse persistent model files license: BSD3@@ -25,6 +25,7 @@ test-suite test type: exitcode-stdio-1.0 main-is: Spec.hs+ other-modules: Database.Persist.ParserSpec default-language: Haskell2010 hs-source-dirs: tests
+ tests/Database/Persist/ParserSpec.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Database.Persist.ParserSpec (+ main+ , spec+ ) where++import Data.Attoparsec.Text+import Data.Either+import Database.Persist.Internal.Parser+import Database.Persist.Syntax.Types+import Test.Hspec++spec :: Spec+spec = do+ describe "Haskell Function Name Parser" $ do+ -- should pass+ it "Should parse function names starting with an underscore" $ do+ let parseResult = parseOnly haskellFunctionName "_get"+ parseResult `shouldBe` (Right "_get")++ it "Should parse function names starting with a lowercase letter" $ do+ let parseResult = parseOnly haskellFunctionName "get"+ parseResult `shouldBe` (Right "get")++ it "Should parse function names with an numbers" $ do+ let parseResult = parseOnly haskellFunctionName "get1"+ parseResult `shouldBe` (Right "get1")++ it "Should parse function names and ignore the trailing whitespace" $ do+ let parseResult = parseOnly haskellFunctionName "get "+ parseResult `shouldBe` (Right "get")++ it "Should parse function names, ignore the trailing whitespace, and the things that follow the whitespace" $ do+ let parseResult = parseOnly haskellFunctionName "get anotherthing"+ parseResult `shouldBe` (Right "get")++ -- should fail+ it "Should not parse inputs that start with whitespace" $ do+ let parseResult = parseOnly haskellFunctionName " _get"+ isLeft parseResult `shouldBe` True++ it "Should not parse function names starting with an uppercase letter" $ do+ let parseResult = parseOnly haskellFunctionName "Get"+ isLeft parseResult `shouldBe` True++ it "Should not parse function names starting with a number" $ do+ let parseResult = parseOnly haskellFunctionName "1get"+ isLeft parseResult `shouldBe` True++ it "Should not parse function names with symbols other than letters, numbers and underscores" $ do+ let parseResults = [ parseOnly haskellFunctionName "get!"+ , parseOnly haskellFunctionName "get$"+ , parseOnly haskellFunctionName "get+"+ , parseOnly haskellFunctionName "get="+ , parseOnly haskellFunctionName "get-"+ ]+ (rights parseResults) `shouldMatchList` []++ describe "Haskell Type Name Parser" $ do+ -- should pass+ it "Should parse type names starting with an uppercase letter" $ do+ let parseResult = parseOnly haskellTypeName "Person"+ parseResult `shouldBe` (Right "Person")++ it "Should parse type names starting with an uppercase letter" $ do+ let parseResult = parseOnly haskellTypeName "Person"+ parseResult `shouldBe` (Right "Person")++ it "Should parse strict type names" $ do+ let parseResult = parseOnly haskellTypeName "!Get"+ parseResult `shouldBe` (Right "Get")++ -- parseResult `shouldBe` (Right "!Get")++ it "Should parse lazy type names" $ do+ let parseResult = parseOnly haskellTypeName "~Get"+ parseResult `shouldBe` (Right "Get")++++ -- should fail++ it "Should not parse type names starting with a lowercase letter" $ do+ let parseResult = parseOnly haskellTypeName "person"+ isLeft parseResult `shouldBe` True++ it "Should not parse type names with symbols other than letters, numbers and underscores" $ do+ let parseResults = [ parseOnly haskellTypeName "Get!"+ , parseOnly haskellTypeName "Get$"+ , parseOnly haskellTypeName "Get+"+ , parseOnly haskellTypeName "Get="+ , parseOnly haskellTypeName "Get-"+ ]+ (rights parseResults) `shouldMatchList` []++ describe "parseEntityPrimary" $ do+ it "should parse" $ do+ let parseResult = parseOnly parseEntityPrimary " Primary name age"+ parseResult `shouldBe` (Right (EntityPrimary ["name","age"]))++ describe "parseEntityForeign" $ do+ it "should parse" $ do+ let parseResult = parseOnly parseEntityForeign " Foreign Tree fkparent parent"+ parseResult `shouldBe` (Right (EntityForeign "Tree" ["fkparent","parent"]))+++ describe "parseMigrationOnlyAndSafeToRemove" $ do++ it "Should parse MigrationOnly" $ do+ let parseResult = parseOnly (parseMigrationOnlyAndSafeToRemove []) " MigrationOnly"+ parseResult `shouldBe` (Right [MigrationOnly])++ it "Should parse SafeToRemove" $ do+ let parseResult = parseOnly (parseMigrationOnlyAndSafeToRemove []) " SafeToRemove"+ parseResult `shouldBe` (Right [SafeToRemove])++ it "Should parse empty space" $ do+ let parseResult = parseOnly (parseMigrationOnlyAndSafeToRemove []) " "+ parseResult `shouldBe` (Right [])++ it "Should parse MigrationOnly and SafeToRemove" $ do+ let parseResult = parseOnly (parseMigrationOnlyAndSafeToRemove []) " MigrationOnly SafeToRemove"+ parseResult `shouldBe` (Right [MigrationOnly,SafeToRemove])++ it "Should parse SafeToRemove and MigrationOnly" $ do+ let parseResult = parseOnly (parseMigrationOnlyAndSafeToRemove []) " SafeToRemove MigrationOnly"+ parseResult `shouldBe` (Right [SafeToRemove,MigrationOnly])++ describe "parseEntityFieldLastItem" $ do+ it "Should parse a default assignment" $ do+ let parseResult = parseOnly (parseEntityFieldLastItem []) " default = Nothing"+ parseResult `shouldBe` (Right [(FieldDefault "Nothing")])++ it "Should parse an sql row assignment" $ do+ let parseResult = parseOnly (parseEntityFieldLastItem []) " sql=person"+ parseResult `shouldBe` (Right [(FieldSqlRow "person")])++ it "Should parse an sql type assignment" $ do+ let parseResult = parseOnly (parseEntityFieldLastItem []) " sqltype=date"+ parseResult `shouldBe` (Right [(FieldSqlType "date")])++ it "Should parse an maxlen assignment" $ do+ let parseResult = parseOnly (parseEntityFieldLastItem []) " maxlen=15"+ parseResult `shouldBe` (Right [(FieldMaxLen 15)])++ it "Should parse mulitple items" $ do+ let parseResult = parseOnly (parseEntityFieldLastItem []) " default = Nothing maxlen=15"+ parseResult `shouldBe` (Right [(FieldDefault "Nothing"), (FieldMaxLen 15)])++ it "Should parse mulitple items" $ do+ let parseResult = parseOnly (parseEntityFieldLastItem []) " default = Nothing maxlen=15 sqltype=date sql=person"+ parseResult `shouldBe` (Right [(FieldDefault "Nothing"), (FieldMaxLen 15),(FieldSqlType "date"), (FieldSqlRow "person")])+++ describe "parseEntity" $ do+ it "parses Entity with only a table name" $ do+ let parseResult = parseOnly (parseEntity) "Person"+ parseResult `shouldBe` (Right (Entity "Person" False Nothing []))++ it "parses Entity with table name and derive json" $ do+ let parseResult = parseOnly (parseEntity) "Person json"+ parseResult `shouldBe` (Right (Entity "Person" True Nothing []))++ it "parses Entity with table name and sql table set to person" $ do+ let parseResult = parseOnly (parseEntity) "Person sql = person"+ parseResult `shouldBe` (Right (Entity "Person" False (Just "person") []))++ it "parses Entity with table name, derive json, and table set to person" $ do+ let parseResult = parseOnly (parseEntity) "Person json sql= person"+ parseResult `shouldBe` (Right (Entity "Person" True (Just "person") []))++ it "parses Entity with table name and one field" $ do+ let parseResult = parseOnly (parseEntity) "Person\n name Text"+ parseResult `shouldBe` (Right (Entity "Person" False Nothing [(EntityChildEntityField $ EntityField "name" (EntityFieldType "Text" Strict False False) False False Nothing Nothing Nothing Nothing)]))++ it "parses Entity with a table name, multiple fields, Unique, Foreign and deriving" $ do+ let parseResult = parseOnly (parseEntity) "Person\n name Text\n phoneNumber Int Maybe\n friends [PersonId]\n UniquePerson name\n deriving Eq Read Show\n Primary name age"+ parseResult `shouldBe` (Right (Entity "Person" False Nothing [(EntityChildEntityField $ EntityField "name" (EntityFieldType "Text" Strict False False) False False Nothing Nothing Nothing Nothing)+ ,(EntityChildEntityField $ EntityField "phoneNumber" (EntityFieldType "Int" Strict False True) False False Nothing Nothing Nothing Nothing)+ ,(EntityChildEntityField $ EntityField "friends" (EntityFieldType "PersonId" Strict True False) False False Nothing Nothing Nothing Nothing)+ ,(EntityChildEntityUnique $ EntityUnique "UniquePerson" ["name"])+ ,(EntityChildEntityDerive $ EntityDerive ["Eq","Read","Show"])+ ,(EntityChildEntityPrimary $ EntityPrimary ["name","age"])]))+++++ describe "parseEntityField" $ do+ it "Should parse a well formed entity field" $ do+ let sampleEntityField = " ident Text"+ let eft = EntityFieldType "Text" Strict False False+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)++ it "Should parse a well formed entity field with a list type" $ do+ let sampleEntityField = " ident [Text]"+ let eft = EntityFieldType "Text" Strict True False+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)++ it "Should parse a well formed entity field with a maybe type" $ do+ let sampleEntityField = " ident Text Maybe"+ let eft = EntityFieldType "Text" Strict False True+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)++ it "Should parse a well formed entity field with a maybe list type" $ do+ let sampleEntityField = " ident [Text] Maybe"+ let eft = EntityFieldType "Text" Strict True True+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)+++ it "Should parse an entity field with explicit a strict type" $ do+ let sampleEntityField = " ident !Text"+ let eft = EntityFieldType "Text" ExplicitStrict False False+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)++ it "Should parse an entity field with a lazy type" $ do+ let sampleEntityField = " ident ~Text"+ let eft = EntityFieldType "Text" Lazy False False+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)++ it "Should parse an entity field with a list of lazy types" $ do+ let sampleEntityField = " ident [~Text]"+ let eft = EntityFieldType "Text" Lazy True False+ let ef = EntityField "ident" eft False False Nothing Nothing Nothing Nothing+ let parseResult = parseOnly parseEntityField sampleEntityField+ parseResult `shouldBe` (Right ef)++ -- describe "parseModelsFile"+ -- describe "parseQuasiQuotersFile"++main :: IO ()+main = hspec spec