Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

✅ - Add Tests #8

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ dependencies:
- containers
- split
- yaml-config
- QuickCheck

library:
source-dirs: src
Expand Down
13 changes: 9 additions & 4 deletions rust-reason.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -37,7 +37,8 @@ library
hs-source-dirs:
src
build-depends:
base >=4.7 && <5
QuickCheck
, base >=4.7 && <5
, casing
, containers
, parsec
Expand All @@ -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
Expand All @@ -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
Expand Down
8 changes: 7 additions & 1 deletion src/SchemaParser.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down
30 changes: 30 additions & 0 deletions test/Helpers.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
module Helpers (genSafeChar, genSafeString, SafeString, safeStringToText, typeToString, checkN) where

import Data.Text
import Test.QuickCheck

checkN x = quickCheckWith (stdArgs {maxSuccess = x})

genSafeChar :: Gen Char
genSafeChar = elements $ ['a' .. 'z'] ++ ['A' .. 'Z']

genSafeString :: Gen Text
genSafeString = pack <$> listOf genSafeChar

newtype SafeString = SafeString {safeStringToText :: Text}
deriving (Show)

instance Arbitrary SafeString where
arbitrary = SafeString <$> genSafeString

genType :: Gen Text
genType = do
lhs <- listOf genSafeChar
rhs <- listOf genSafeChar
pure $ pack $ lhs <> "->" <> rhs <> ","

newtype SchemaTypeDefinition = SchemaTypeDefinition {typeToString :: Text}
deriving (Show)

instance Arbitrary SchemaTypeDefinition where
arbitrary = SchemaTypeDefinition <$> genType
42 changes: 42 additions & 0 deletions test/SchemaParserSpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,42 @@
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}

module SchemaParserSpec (run) where

import Data.Text
import Helpers
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 (toText s1) (toText s2) == Right (strip $ toText s1, strip $ toText s2)

-- parseQualifiedType
parseQualifiedType :: Text -> Text -> Either ParseError (Text, Text)
parseQualifiedType s1 s2 = runParser SchemaParser.parseQualifiedType () parseError (s1 <> "." <> s2)

parseQualifiedTypeTest :: SafeString -> SafeString -> Bool
parseQualifiedTypeTest = parseToEither parseQualifiedType

-- ParseTypecontainer
parseTypeContainer :: Text -> Text -> Either ParseError (Text, Text)
parseTypeContainer s1 s2 = runParser SchemaParser.parseTypeContainer () parseError (s1 <> "<" <> s2 <> ">")

parseTypeContainerTest :: SafeString -> SafeString -> Bool
parseTypeContainerTest = parseToEither parseTypeContainer

-- ParseType
parseType :: Text -> Text -> Either ParseError (Text, Text)
parseType s1 s2 = runParser SchemaParser.parseType () parseError (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
4 changes: 3 additions & 1 deletion test/Spec.hs
Original file line number Diff line number Diff line change
@@ -1,2 +1,4 @@
import qualified SchemaParserSpec

main :: IO ()
main = putStrLn "Test suite not yet implemented"
main = SchemaParserSpec.run