diff --git a/package.yaml b/package.yaml index 7c51c3a..6f4e553 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,7 @@ dependencies: - containers - split - yaml-config +- QuickCheck library: source-dirs: src diff --git a/rust-reason.cabal b/rust-reason.cabal index d40ff60..1907aa0 100644 --- a/rust-reason.cabal +++ b/rust-reason.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d638651666de833bab61ad9a173ef67bf5aabd3290dd88338fa71adc5cd880b5 +-- hash: 3eb8f8d21cdd6cc07bf7067e8b9eaebc24c7b9c726abf24c4de7ca8584a419f4 name: rust-reason version: 0.1.0.0 @@ -37,7 +37,8 @@ library hs-source-dirs: src build-depends: - base >=4.7 && <5 + QuickCheck + , base >=4.7 && <5 , casing , containers , parsec @@ -54,7 +55,8 @@ executable rust-reason-exe app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + QuickCheck + , base >=4.7 && <5 , casing , containers , parsec @@ -68,12 +70,15 @@ test-suite rust-reason-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Helpers + SchemaParserSpec Paths_rust_reason hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + QuickCheck + , base >=4.7 && <5 , casing , containers , parsec diff --git a/src/SchemaParser.hs b/src/SchemaParser.hs index 68e793b..39930c2 100644 --- a/src/SchemaParser.hs +++ b/src/SchemaParser.hs @@ -1,6 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module SchemaParser (parseTypeContainer, parseSchema) where +module SchemaParser + ( parseQualifiedType, + parseTypeContainer, + parseType, + parseSchema, + ) +where import Data.Set (member) import qualified Data.Text as T diff --git a/test/Helpers.hs b/test/Helpers.hs new file mode 100644 index 0000000..3df7c79 --- /dev/null +++ b/test/Helpers.hs @@ -0,0 +1,20 @@ +module Helpers (genSafeChar, genSafeString, SafeString, toString, checkN) where + +import Test.QuickCheck + +checkN x = quickCheckWith (stdArgs {maxSuccess = x}) + +genSafeChar :: Gen Char +genSafeChar = elements $ ['a' .. 'z'] ++ ['A' .. 'Z'] + +genSafeString :: Gen String +genSafeString = listOf genSafeChar + +newtype SafeString = SafeString {toString :: String} + deriving (Show) + +instance Arbitrary SafeString where + arbitrary = SafeString <$> genSafeString + +genType :: Gen String +genType = listOf genSafeChar diff --git a/test/SchemaParserSpec.hs b/test/SchemaParserSpec.hs new file mode 100644 index 0000000..0dc9ee8 --- /dev/null +++ b/test/SchemaParserSpec.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE NumericUnderscores #-} + +module SchemaParserSpec (run) where + +import qualified Data.Text as T +import Helpers (SafeString, checkN, toString) +import qualified SchemaParser +import Test.QuickCheck +import Text.Parsec + +parseError = "Some Parse Error" + +-- (String, String) -> Either ParseError (T.Text, T.Text) +parseToEither fn s1 s2 = fn (toString s1) (toString s2) == Right (T.strip $ T.pack $ toString s1, T.strip $ T.pack $ toString s2) + +-- parseQualifiedType +parseQualifiedType :: String -> String -> Either ParseError (T.Text, T.Text) +parseQualifiedType s1 s2 = runParser SchemaParser.parseQualifiedType () parseError (T.pack (s1 <> "." <> s2)) + +parseQualifiedTypeTest :: SafeString -> SafeString -> Bool +parseQualifiedTypeTest = parseToEither parseQualifiedType + +-- ParseTypecontainer +parseTypeContainer :: String -> String -> Either ParseError (T.Text, T.Text) +parseTypeContainer s1 s2 = runParser SchemaParser.parseTypeContainer () parseError (T.pack (s1 <> "<" <> s2 <> ">")) + +parseTypeContainerTest :: SafeString -> SafeString -> Bool +parseTypeContainerTest = parseToEither parseTypeContainerTest + +-- ParseType +parseType :: String -> String -> Either ParseError (T.Text, T.Text) +parseType s1 s2 = runParser SchemaParser.parseType () parseError (T.pack (s1 <> "->" <> s2 <> ",")) + +parseTypeTest :: SafeString -> SafeString -> Bool +parseTypeTest = parseToEither parseType + +run :: IO () +run = do + checkN 1_000 parseTypeTest + checkN 1_000 parseTypeContainerTest + checkN 1_000 parseQualifiedTypeTest diff --git a/test/Spec.hs b/test/Spec.hs index cd4753f..b4b3d1b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,4 @@ +import qualified SchemaParserSpec + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = SchemaParserSpec.run