From e5285e5c8f191be8364032af46945093dddd0dab Mon Sep 17 00:00:00 2001
From: Rowan Torbitzky-Lane <rowan.a.tl@protonmail.com>
Date: Fri, 31 Jan 2025 23:50:07 -0600
Subject: [PATCH] quickcheck class implementations done

---
 HushGP.cabal           |  3 +-
 src/LearnQuickCheck.hs | 35 ++++++++++++++++++++++++
 src/State.hs           | 62 ++++++++++++++++++++++++++++++++++++++----
 test/Main.hs           |  8 ++++++
 4 files changed, 101 insertions(+), 7 deletions(-)

diff --git a/HushGP.cabal b/HushGP.cabal
index 1a7b203..6752025 100644
--- a/HushGP.cabal
+++ b/HushGP.cabal
@@ -119,4 +119,5 @@ test-suite HushGP-test
     -- Test dependencies.
     build-depends:
         base,
-        HushGP
+        HushGP,
+        QuickCheck
diff --git a/src/LearnQuickCheck.hs b/src/LearnQuickCheck.hs
index da25434..f015789 100644
--- a/src/LearnQuickCheck.hs
+++ b/src/LearnQuickCheck.hs
@@ -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
diff --git a/src/State.hs b/src/State.hs
index a19516c..242008e 100644
--- a/src/State.hs
+++ b/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)
diff --git a/test/Main.hs b/test/Main.hs
index e69de29..b386a2d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -0,0 +1,8 @@
+import State
+import Test.QuickCheck
+
+main :: IO ()
+main = do
+  putStrLn "hello"
+
+