From 84c876f1b543610fe1954195b86accb1a44d5943 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20P=C3=A4tzel?= <david.paetzel@posteo.de>
Date: Tue, 22 Oct 2019 08:14:16 +0200
Subject: [PATCH] Add basis for tests to GA module

---
 src/GA.hs   | 26 +++++++++++++-------------
 src/Test.hs |  2 ++
 2 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/src/GA.hs b/src/GA.hs
index 94d62d9..2a5c1e7 100644
--- a/src/GA.hs
+++ b/src/GA.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module GA where
@@ -20,19 +21,7 @@ import Pretty
 import Protolude
 import Test.QuickCheck hiding (sample, shuffle)
 import Test.QuickCheck.Instances
-
--- TODO using sample here was a quick hack
-{-|
-Shuffles a non-empty list.
--}
-shuffle' :: (MonadRandom m) => NonEmpty a -> m (NonEmpty a)
-shuffle' xs = do
-  i <- sample . uniform 0 $ NE.length xs - 1
-  let x = xs NE.!! i
-  xs' <- sample . shuffle $ deleteI i xs
-  return $ x :| xs'
-  where
-    deleteI i xs = fst (NE.splitAt (i - 1) xs) ++ snd (NE.splitAt i xs)
+import Test.QuickCheck.Monadic
 
 -- TODO enforce this being > 0
 type N = Int
@@ -98,6 +87,12 @@ newtype Population a = Pop {unPop :: NonEmpty a}
 instance (Arbitrary i) => Arbitrary (Population i) where
   arbitrary = Pop <$> arbitrary
 
+{-|
+The population's size (the length of the internally used non-empty list).
+-}
+size :: Population a -> N
+size = NE.length . unPop
+
 {-|
 Selects one individual from the population using proportionate selection.
 -}
@@ -140,6 +135,7 @@ children2 nX i1 i2 = do
 The @k@ best individuals in the population when comparing using the supplied
 function.
 -}
+-- TODO do this without a complete sort
 bestsBy :: (Individual i, Monad m) => N -> (i -> m R) -> Population i -> m [i]
 bestsBy k f =
   fmap (NE.take k . fmap fst . NE.sortBy (comparing (Down . snd)))
@@ -218,3 +214,7 @@ Termination after a number of steps.
 -}
 steps :: N -> Termination i
 steps tEnd _ t = t >= tEnd
+
+return []
+
+runTests = $quickCheckAll
diff --git a/src/Test.hs b/src/Test.hs
index ac1361e..c320594 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -4,8 +4,10 @@ module Main where
 
 import Protolude
 import qualified Seminar
+import qualified GA
 
 main :: IO ()
 main = do
   _ <- Seminar.runTests
+  _ <- GA.runTests
   return ()