This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/test/FoundationSpec.hs
2020-01-15 17:20:13 +01:00

97 lines
2.4 KiB
Haskell

module FoundationSpec where
import TestImport
import ModelSpec ()
import qualified Data.CryptoID as CID
import Yesod.EmbeddedStatic
instance Arbitrary (Route Auth) where
arbitrary = oneof
[ return CheckR
, return LoginR
, return LogoutR
, PluginR <$> arbitrary <*> arbitrary
]
instance Arbitrary (Route EmbeddedStatic) where
arbitrary = do
let printableText = pack . filter (/= '/') . getPrintableString <$> arbitrary
printableText' = printableText `suchThat` (not . null)
pathLength <- getPositive <$> arbitrary
path <- replicateM pathLength printableText'
paramNum <- getNonNegative <$> arbitrary
params <- replicateM paramNum $ (,) <$> printableText' <*> printableText
return $ embeddedResourceR path params
instance Arbitrary WellKnownFileName where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary SchoolR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary CourseR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary SheetR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary SubmissionR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary MaterialR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary TutorialR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary ExamR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary CourseApplicationR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary AllocationR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary ExamOfficeR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary EExamR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary CourseNewsR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary CourseEventR where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (Route UniWorX) where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary a => Arbitrary (CID.CryptoID ns a) where
arbitrary = CID.CryptoID <$> arbitrary
spec :: Spec
spec = do
parallel $
lawsCheckHspec (Proxy @(Route UniWorX))
[ eqLaws, hashableLaws, jsonLaws, jsonKeyLaws, pathPieceLaws ]