79 lines
1.9 KiB
Haskell
79 lines
1.9 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
|
|
pathLength <- getPositive <$> arbitrary
|
|
path <- replicateM pathLength printableText
|
|
paramNum <- getNonNegative <$> arbitrary
|
|
params <- replicateM paramNum $ (,) <$> printableText <*> printableText
|
|
return $ embeddedResourceR path params
|
|
|
|
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 (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 ]
|