quickcheck class implementations done
This commit is contained in:
parent
125f137643
commit
e5285e5c8f
@ -119,4 +119,5 @@ test-suite HushGP-test
|
||||
-- Test dependencies.
|
||||
build-depends:
|
||||
base,
|
||||
HushGP
|
||||
HushGP,
|
||||
QuickCheck
|
||||
|
@ -153,3 +153,38 @@ genCards = do
|
||||
|
||||
genListOf15Ints :: Gen [Int]
|
||||
genListOf15Ints = resize 15 $ sized $ \n -> replicateM n arbitrary
|
||||
|
||||
-- Next section covers this. QuickCheck with custom data declarations
|
||||
-- http://geekyplatypus.com/y-u-have-no-code-samples-quickcheck/
|
||||
|
||||
data Point = Pt Int Int
|
||||
|
||||
instance Show Point where
|
||||
show (Pt x y) = "{" ++ show x ++ "," ++ show y ++ "}"
|
||||
|
||||
instance Arbitrary Point where
|
||||
arbitrary = do
|
||||
x <- arbitrary
|
||||
-- y <- arbitrary
|
||||
-- return $ Pt x y
|
||||
-- could do
|
||||
Pt x <$> arbitrary
|
||||
|
||||
data Set a = Set [a]
|
||||
|
||||
instance (Show a) => Show (Set a) where
|
||||
show s = showSet s where
|
||||
showSet (Set []) = "{}"
|
||||
showSet (Set (x:xs)) = "{" <> show x <> showSubSet xs <> "}" where
|
||||
showSubSet [] = ""
|
||||
showSubSet (ix:ixs) = "," <> show ix <> showSubSet ixs
|
||||
|
||||
instance (Arbitrary a) => Arbitrary (Set a) where
|
||||
arbitrary = do Set <$> arbitrary
|
||||
-- list <- arbitrary
|
||||
-- return $ Set list
|
||||
|
||||
-- sample $ (arbitrary :: Gen (Set Int))
|
||||
|
||||
-- This link also seems interesting
|
||||
-- https://devtut.github.io/haskell/quickcheck.html
|
||||
|
62
src/State.hs
62
src/State.hs
@ -1,9 +1,11 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TemplateHaskell, DeriveGeneric #-}
|
||||
|
||||
module State where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens hiding (elements)
|
||||
import Data.Map qualified as Map
|
||||
import Test.QuickCheck
|
||||
import GHC.Generics
|
||||
|
||||
-- The exec stack must store heterogenous types,
|
||||
-- and we must be able to detect that type at runtime.
|
||||
@ -24,6 +26,7 @@ data Gene
|
||||
| PlaceInput String
|
||||
| Close
|
||||
| Block [Gene]
|
||||
deriving Generic
|
||||
|
||||
instance Eq Gene where
|
||||
GeneInt x == GeneInt y = x == y
|
||||
@ -48,8 +51,8 @@ instance Show Gene where
|
||||
show (GeneBool x) = "Bool: " <> show x
|
||||
show (GeneString x) = "String: " <> x
|
||||
show (GeneChar x) = "Char: " <> show x
|
||||
show (StateFunc _) = "Func: unnamed"
|
||||
show (PlaceInput x) = "In: " <> x
|
||||
show (StateFunc x) = "Func: " <> show x
|
||||
show (PlaceInput x) = "In: " <> show x
|
||||
show (GeneVectorInt xs) = "Int Vec: " <> show xs
|
||||
show (GeneVectorFloat xs) = "Float Vec: " <> show xs
|
||||
show (GeneVectorBool xs) = "Bool Vec: " <> show xs
|
||||
@ -58,6 +61,26 @@ instance Show Gene where
|
||||
show Close = "Close"
|
||||
show (Block xs) = "Block: " <> show xs
|
||||
|
||||
instance CoArbitrary Gene
|
||||
|
||||
instance Arbitrary Gene where
|
||||
arbitrary = oneof [
|
||||
GeneInt <$> arbitrary,
|
||||
GeneFloat <$> arbitrary,
|
||||
GeneBool <$> arbitrary,
|
||||
GeneString <$> arbitrary,
|
||||
GeneChar <$> arbitrary,
|
||||
StateFunc <$> arbitrary,
|
||||
PlaceInput <$> arbitrary,
|
||||
GeneVectorInt <$> arbitrary,
|
||||
GeneVectorFloat <$> arbitrary,
|
||||
GeneVectorBool <$> arbitrary,
|
||||
GeneVectorString <$> arbitrary,
|
||||
GeneVectorChar <$> arbitrary,
|
||||
Block <$> arbitrary,
|
||||
return Close
|
||||
]
|
||||
|
||||
data State = State
|
||||
{ _exec :: [Gene],
|
||||
_code :: [Gene],
|
||||
@ -74,9 +97,32 @@ data State = State
|
||||
_parameter :: [Gene],
|
||||
_input :: Map.Map String Gene
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
$(makeLenses ''State)
|
||||
-- This needs to be updated later
|
||||
instance Show (State -> State) where
|
||||
show _ = "unnamed"
|
||||
|
||||
instance Arbitrary State where
|
||||
arbitrary = do
|
||||
arbExec <- arbitrary
|
||||
arbCode <- arbitrary
|
||||
arbInt <- arbitrary
|
||||
arbFloat <- arbitrary
|
||||
arbBool <- arbitrary
|
||||
arbString <- arbitrary
|
||||
arbChar <- arbitrary
|
||||
arbVectorInt <- arbitrary
|
||||
arbVectorFloat <- arbitrary
|
||||
arbVectorBool <- arbitrary
|
||||
arbVectorString <- arbitrary
|
||||
arbVectorChar <- arbitrary
|
||||
arbParameter <- arbitrary
|
||||
-- arbInput <- arbitrary
|
||||
State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
|
||||
-- Thanks hlint lol
|
||||
|
||||
instance CoArbitrary State
|
||||
|
||||
emptyState :: State
|
||||
emptyState =
|
||||
@ -115,3 +161,7 @@ exampleState =
|
||||
_vectorChar = [['z', 'x'], ['r', 'a', 't', 'l']],
|
||||
_input = Map.empty
|
||||
}
|
||||
|
||||
-- This must stay at the end of the file.
|
||||
-- Template haskell seems to be messing with GHC.Generics
|
||||
$(makeLenses ''State)
|
||||
|
@ -0,0 +1,8 @@
|
||||
import State
|
||||
import Test.QuickCheck
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "hello"
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user