module TypeCheck.ApiSpec where
import Control.Monad (liftM)
import Data.DeriveTH
import qualified Data.Map as M
import qualified Data.Set as S
import Test.QuickCheck
type Id = String
type Route = String
type EnumValue = String
type EnumInfo = [EnumValue]
data Modifier =
Hidden
| Immutable
| Required
| PrimaryKey
| Unique
| UserLogin
deriving (Eq, Ord, Show)
derive makeArbitrary ''Modifier
newtype FieldInfo = FI (Id, Type, S.Set Modifier) deriving (Show, Eq, Ord)
type StructInfo = [FieldInfo]
type ResourceInfo = (Route, Writable)
data Type = TInt
| TLong
| TFloat
| TDouble
| TBool
| TString
| TEnum Id
| TStruct Id
| TList Type deriving (Eq, Ord, Show)
instance (CoArbitrary Type) where
coarbitrary = coarbitraryShow
type Enums = M.Map Id EnumInfo
type Structs = [(Id, StructInfo)]
type Resources = M.Map Id ResourceInfo
type Writable = Bool
data ApiSpec = AS { name :: String
, version :: String
, requiresAuth :: Bool
, enums :: Enums
, structs :: Structs
, resources :: Resources
}
derive makeShow ''ApiSpec
getPrimaryKey :: StructInfo
-> Maybe Id
getPrimaryKey structInfo =
case filter hasPkModifier structInfo of
[] -> Nothing
[FI (x, _, _)] -> Just x
_ -> error "A struct should have at most one specified primary key."
where
hasPkModifier (FI (_, _, modifiers)) = PrimaryKey `S.member` modifiers
isStructField :: FieldInfo -> Bool
isStructField (FI (_, t, _)) = isStruct t
isStruct :: Type -> Bool
isStruct (TStruct _) = True
isStruct (TList t) = isStruct t
isStruct _ = False
strName :: Type -> String
strName (TStruct t) = t
strName (TList t) = strName t
strName other = error $ "strName of a non struct type (" ++ show other ++ ")"
nonEmptyString :: Gen String
nonEmptyString = listOf1 arbitrary
generateRandomFieldInfo :: [Id] -> [Id] -> Gen FieldInfo
generateRandomFieldInfo enumIds structIds =
do
id <- nonEmptyString
t <- generateRandomType enumIds structIds
modifiers <- listOf arbitrary
return $ FI (id, t, S.fromList modifiers)
where
generateRandomType :: [Id] -> [Id] -> Gen Type
generateRandomType enumIds structIds = do
t <- arbitrary
case t of
(TStruct _) -> processStruct
(TEnum _) -> processEnum
(TList t') | needsEnumId t' ->
if null enumIds
then generateRandomType enumIds structIds
else do
newId <- elements enumIds
return $ TList $ setNewId newId t'
| needsStructId t' ->
if null structIds
then generateRandomType enumIds structIds
else do
newId <- elements structIds
return $ TList $ setNewId newId t'
| otherwise -> return $ TList t'
other -> return other
where
processEnum = if null enumIds
then generateRandomType enumIds structIds
else liftM TEnum $ elements enumIds
processStruct = if null structIds
then generateRandomType enumIds structIds
else liftM TStruct $ elements structIds
needsEnumId (TEnum _) = True
needsEnumId (TList t) = needsEnumId t
needsEnumId _ = False
needsStructId (TStruct _) = True
needsStructId (TList t) = needsStructId t
needsStructId _ = False
setNewId newId' (TEnum _) = TEnum newId'
setNewId newId' (TStruct _) = TStruct newId'
setNewId newId' (TList t) = TList $ setNewId newId' t
setNewId _ t = t
instance (Arbitrary ApiSpec) where
arbitrary = do
name' <- nonEmptyString
version' <- nonEmptyString
enumIds <- listOf nonEmptyString
enums' <- mapM createEnum enumIds
structIds <- listOf nonEmptyString
structs' <- mapM (createStruct enumIds structIds) structIds
resources' <- mapM (createResource . fst) structs'
return AS { name = name'
, version = version'
, requiresAuth = False
, enums = M.fromList enums'
, structs = structs'
, resources = M.fromList resources'
}
where
createEnum :: Id -> Gen (Id, EnumInfo)
createEnum id = do
values <- listOf1 nonEmptyString
return (id, values)
createStruct :: [Id] -> [Id] -> Id -> Gen (Id, StructInfo)
createStruct enumIds structIds thisStructId = do
rawFields <- listOf1 $ generateRandomFieldInfo enumIds structIds
shouldHavePk <- arbitrary
let fields = filterPrimaryKey shouldHavePk rawFields
return (thisStructId, fields)
where
filterPrimaryKey _ [] = []
filterPrimaryKey True (FI (id, t, mods):fs) | PrimaryKey `S.member` mods = FI (id, t, PrimaryKey `S.delete` mods) : filterPrimaryKey False fs
filterPrimaryKey True (FI (id, t, mods):fs) = FI (id, t, mods) : filterPrimaryKey True fs
filterPrimaryKey False (FI (id, t, mods):fs) = FI (id, t, PrimaryKey `S.delete` mods) : filterPrimaryKey False fs
createResource :: Id -> Gen (Id, ResourceInfo)
createResource id = do
route <- nonEmptyString
writable <- arbitrary
return (id, (route, writable))
instance (Arbitrary Type) where
arbitrary = do
t <- elements [TInt, TLong, TFloat, TDouble, TBool, TString, TEnum "", TStruct "", TList TInt]
case t of
TEnum _ -> liftM TEnum nonEmptyString
TStruct _ -> liftM TStruct nonEmptyString
TList _ -> liftM TList arbitrary
other -> return other