quickcheck class implementations done
This commit is contained in:
parent
125f137643
commit
e5285e5c8f
@ -119,4 +119,5 @@ test-suite HushGP-test
|
|||||||
-- Test dependencies.
|
-- Test dependencies.
|
||||||
build-depends:
|
build-depends:
|
||||||
base,
|
base,
|
||||||
HushGP
|
HushGP,
|
||||||
|
QuickCheck
|
||||||
|
@ -153,3 +153,38 @@ genCards = do
|
|||||||
|
|
||||||
genListOf15Ints :: Gen [Int]
|
genListOf15Ints :: Gen [Int]
|
||||||
genListOf15Ints = resize 15 $ sized $ \n -> replicateM n arbitrary
|
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
|
module State where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens hiding (elements)
|
||||||
import Data.Map qualified as Map
|
import Data.Map qualified as Map
|
||||||
|
import Test.QuickCheck
|
||||||
|
import GHC.Generics
|
||||||
|
|
||||||
-- The exec stack must store heterogenous types,
|
-- The exec stack must store heterogenous types,
|
||||||
-- and we must be able to detect that type at runtime.
|
-- and we must be able to detect that type at runtime.
|
||||||
@ -24,6 +26,7 @@ data Gene
|
|||||||
| PlaceInput String
|
| PlaceInput String
|
||||||
| Close
|
| Close
|
||||||
| Block [Gene]
|
| Block [Gene]
|
||||||
|
deriving Generic
|
||||||
|
|
||||||
instance Eq Gene where
|
instance Eq Gene where
|
||||||
GeneInt x == GeneInt y = x == y
|
GeneInt x == GeneInt y = x == y
|
||||||
@ -48,8 +51,8 @@ instance Show Gene where
|
|||||||
show (GeneBool x) = "Bool: " <> show x
|
show (GeneBool x) = "Bool: " <> show x
|
||||||
show (GeneString x) = "String: " <> x
|
show (GeneString x) = "String: " <> x
|
||||||
show (GeneChar x) = "Char: " <> show x
|
show (GeneChar x) = "Char: " <> show x
|
||||||
show (StateFunc _) = "Func: unnamed"
|
show (StateFunc x) = "Func: " <> show x
|
||||||
show (PlaceInput x) = "In: " <> x
|
show (PlaceInput x) = "In: " <> show x
|
||||||
show (GeneVectorInt xs) = "Int Vec: " <> show xs
|
show (GeneVectorInt xs) = "Int Vec: " <> show xs
|
||||||
show (GeneVectorFloat xs) = "Float Vec: " <> show xs
|
show (GeneVectorFloat xs) = "Float Vec: " <> show xs
|
||||||
show (GeneVectorBool xs) = "Bool Vec: " <> show xs
|
show (GeneVectorBool xs) = "Bool Vec: " <> show xs
|
||||||
@ -58,6 +61,26 @@ instance Show Gene where
|
|||||||
show Close = "Close"
|
show Close = "Close"
|
||||||
show (Block xs) = "Block: " <> show xs
|
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
|
data State = State
|
||||||
{ _exec :: [Gene],
|
{ _exec :: [Gene],
|
||||||
_code :: [Gene],
|
_code :: [Gene],
|
||||||
@ -74,9 +97,32 @@ data State = State
|
|||||||
_parameter :: [Gene],
|
_parameter :: [Gene],
|
||||||
_input :: Map.Map String 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 :: State
|
||||||
emptyState =
|
emptyState =
|
||||||
@ -115,3 +161,7 @@ exampleState =
|
|||||||
_vectorChar = [['z', 'x'], ['r', 'a', 't', 'l']],
|
_vectorChar = [['z', 'x'], ['r', 'a', 't', 'l']],
|
||||||
_input = Map.empty
|
_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