creatur 5.9.1 → 5.9.2
raw patch · 5 files changed
+332/−5 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- creatur.cabal +10/−5
- test/ALife/Creatur/ChecklistQC.hs +78/−0
- test/ALife/Creatur/Genetics/BRGCBoolBench.hs +57/−0
- test/ALife/Creatur/Genetics/BRGCWord8Bench.hs +65/−0
- test/ALife/Creatur/UniverseQC.hs +122/−0
creatur.cabal view
@@ -1,5 +1,5 @@ Name: creatur-Version: 5.9.1+Version: 5.9.2 Stability: experimental Synopsis: Framework for artificial life experiments. Description: A software framework for automating experiments@@ -36,7 +36,7 @@ source-repository this type: git location: https://github.com/mhwombat/creatur.git- tag: 5.9.1+ tag: 5.9.2 library GHC-Options: -Wall -fno-warn-orphans@@ -110,16 +110,21 @@ test-framework-hunit ==0.3.*, test-framework-quickcheck2 ==0.3.*, QuickCheck ==2.7.*- Other-modules: ALife.Creatur.UtilQC+ Other-modules: ALife.Creatur.ChecklistQC ALife.Creatur.CounterQC ALife.Creatur.Database.CachedFileSystemQC ALife.Creatur.Database.FileSystemQC- ALife.Creatur.Genetics.DiploidQC,+ ALife.Creatur.Genetics.BRGCBoolBench ALife.Creatur.Genetics.BRGCBoolQC- ALife.Creatur.Genetics.BRGCWord8QC ALife.Creatur.Genetics.BRGCWord16QC+ ALife.Creatur.Genetics.BRGCWord8Bench+ ALife.Creatur.Genetics.BRGCWord8QC+ ALife.Creatur.Genetics.DiploidQC, ALife.Creatur.Genetics.RecombinationQC ALife.Creatur.PersistentQC+ ALife.Creatur.UniverseQC+ ALife.Creatur.UtilQC+ -- Benchmark creatur-bench -- Type: exitcode-stdio-1.0
+ test/ALife/Creatur/ChecklistQC.hs view
@@ -0,0 +1,78 @@+------------------------------------------------------------------------+-- |+-- Module : ALife.Creatur.ChecklistQC+-- Copyright : (c) Amy de Buitléir 2013-2015+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE DeriveGeneric #-}++module ALife.Creatur.ChecklistQC+ (+ test+ ) where++import qualified ALife.Creatur as A+import ALife.Creatur.Database (Record, key)+import ALife.Creatur.Checklist+import Control.Monad.State (execStateT, evalStateT)+import Data.Serialize (Serialize)+import GHC.Generics (Generic)+import System.IO.Temp (withSystemTempDirectory)+import Test.Framework as TF (Test, testGroup)+import Test.HUnit as TH (assertEqual, assertBool)+import Test.Framework.Providers.HUnit (testCase)++data TestAgent = TestAgent { aAgentId :: String, aIsAlive :: Bool }+ deriving (Eq, Show, Generic)++instance Serialize TestAgent++instance A.Agent TestAgent where+ agentId = aAgentId+ isAlive = aIsAlive++instance Record TestAgent where+ key = aAgentId++testChecklist :: IO ()+testChecklist = withSystemTempDirectory "creaturTest.tmp" testChecklist'++testChecklist' :: FilePath -> IO ()+testChecklist' dir = do+ let filename = dir ++ "/checklist"+ let c = mkPersistentChecklist filename+ c1 <- execStateT (setItems ["taskA", "taskB", "taskC"]) c+ s1 <- evalStateT status c1+ assertEqual "test1" (["taskA", "taskB", "taskC"],[]) s1++ c2 <- execStateT (markDone "taskB") c1+ s2 <- evalStateT status c2+ assertEqual "test2" (["taskA", "taskC"],["taskB"]) s2++ c3 <- execStateT (delete "taskA") c2+ s3 <- evalStateT status c3+ assertEqual "test3" (["taskC"],["taskB"]) s3++ c4 <- execStateT (markDone "taskA") c3+ s4 <- evalStateT status c4+ assertEqual "test4" (["taskC"],["taskB"]) s4++ c5 <- execStateT (markDone "taskC") c4+ s5 <- evalStateT status c5+ assertEqual "test5" ([],["taskB", "taskC"]) s5+ d5 <- evalStateT done c5+ assertBool "test5a" d5++test :: TF.Test+test = testGroup "HUnit ALife.Creatur.ChecklistQC"+ [+ testCase "testChecklist" testChecklist+ ]++
+ test/ALife/Creatur/Genetics/BRGCBoolBench.hs view
@@ -0,0 +1,57 @@+------------------------------------------------------------------------+-- |+-- Module : ALife.Creatur.Genetics.BRGCBoolBench+-- Copyright : (c) Amy de Buitléir 2014-2015+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- Benchmarks.+--+------------------------------------------------------------------------+{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}+module ALife.Creatur.Genetics.BRGCBoolBench+ (+ benchmark+ ) where++import Prelude hiding (read)+import ALife.Creatur.Genetics.BRGCBool+import Data.Word (Word8)+import Criterion.Main (Benchmark, Pure, nf, bgroup, bench)++word8 :: Word8+word8 = 0++word8Encoded :: [Bool]+word8Encoded = write word8+ +putWord8Benchmark :: Pure+putWord8Benchmark = nf write word8++getWord8Benchmark :: Pure+getWord8Benchmark = nf (read :: Sequence -> Either [String] Word8) word8Encoded++word8s :: [Word8]+word8s = [0..255]++word8sEncoded :: [Bool]+word8sEncoded = write word8s++putWord8sBenchmark :: Pure+putWord8sBenchmark = nf write word8s++getWord8sBenchmark :: Pure+getWord8sBenchmark = nf (read :: Sequence -> Either [String] [Word8]) word8sEncoded++benchmark :: Benchmark+benchmark = bgroup "ALife.Creatur.Genetics.BRGCBoolBench"+ [+ bench "put Word8" putWord8Benchmark,+ bench "get Word8" getWord8Benchmark,+ bench "put [Word8]" putWord8sBenchmark,+ bench "get [Word8]" getWord8sBenchmark+ ]++
+ test/ALife/Creatur/Genetics/BRGCWord8Bench.hs view
@@ -0,0 +1,65 @@+------------------------------------------------------------------------+-- |+-- Module : ALife.Creatur.Genetics.BRGCWord8Bench+-- Copyright : (c) Amy de Buitléir 2014-2015+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- Benchmarks.+--+------------------------------------------------------------------------+{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}+module ALife.Creatur.Genetics.BRGCWord8Bench+ (+ benchmark+ ) where++import Prelude hiding (read)+import ALife.Creatur.Genetics.BRGCWord8+import Data.Word (Word8)+import Criterion.Main (Benchmark, Pure, nf, bgroup, bench)++word8 :: Word8+word8 = 0++word8Encoded :: [Word8]+word8Encoded = write word8+ +putWord8Benchmark :: Pure+putWord8Benchmark = nf write word8++getWord8Benchmark :: Pure+getWord8Benchmark = nf (read :: Sequence -> Either [String] Word8) word8Encoded++word8s :: [Word8]+word8s = concatMap (replicate 10) [0..255]++word8sEncoded :: [Word8]+word8sEncoded = write word8s++putWord8sBenchmark :: Pure+putWord8sBenchmark = nf write word8s++getWord8sBenchmark :: Pure+getWord8sBenchmark = nf (read :: Sequence -> Either [String] [Word8]) word8sEncoded++-- putRawWord8sBenchmark :: Pure+-- putRawWord8sBenchmark = nf (runWriter putRawWord8s) word8s++-- getRawWord8sBenchmark :: Pure+-- getRawWord8sBenchmark = nf (runReader getRawWord8sBenchmark) word8sEncoded++benchmark :: Benchmark+benchmark = bgroup "ALife.Creatur.Genetics.BRGCWord8Bench"+ [+ bench "put Word8" putWord8Benchmark,+ bench "get Word8" getWord8Benchmark,+ bench "put [Word8]" putWord8sBenchmark,+ bench "get [Word8]" getWord8sBenchmark+ -- bench "putRaw [Word8]" putRawWord8sBenchmark,+ -- bench "getRaw [Word8]" getRawWord8sBenchmark+ ]++
+ test/ALife/Creatur/UniverseQC.hs view
@@ -0,0 +1,122 @@+------------------------------------------------------------------------+-- |+-- Module : ALife.Creatur.UniverseQC+-- Copyright : (c) Amy de Buitléir 2012-2015+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE DeriveGeneric #-}++module ALife.Creatur.UniverseQC+ (+ test+ ) where++import qualified ALife.Creatur as A+import ALife.Creatur.Database (Record, key)+import ALife.Creatur.Universe+import Control.Monad.State (execStateT, evalStateT, runStateT)+import Data.Serialize (Serialize)+import GHC.Generics (Generic)+import System.Directory (doesFileExist, doesDirectoryExist)+import System.IO.Temp (withSystemTempDirectory)+import Test.Framework as TF (Test, testGroup)+import Test.HUnit as TH (assertEqual, assertBool)+import Test.Framework.Providers.HUnit (testCase)++data TestAgent = TestAgent { aAgentId :: String, aIsAlive :: Bool }+ deriving (Eq, Show, Generic)++instance Serialize TestAgent++instance A.Agent TestAgent where+ agentId = aAgentId+ isAlive = aIsAlive++instance Record TestAgent where+ key = aAgentId++testUniverseCreation :: IO ()+testUniverseCreation = withSystemTempDirectory "creaturTest.tmp" testUniverseCreation'++testUniverseCreation' :: FilePath -> IO ()+testUniverseCreation' dir = do+ let logFileName = dir ++ "/universe"+ let u = mkSimpleUniverse "wombat" logFileName :: SimpleUniverse TestAgent+ (t, u2) <- runStateT currentTime u+ assertEqual "test1" 0 t+ dirExists <- doesDirectoryExist logFileName+ assertBool "universe created too early" (not dirExists)++ u3 <- execStateT incTime u2+ t2 <- evalStateT currentTime u3+ assertEqual "test2" 1 t2++ -- Re-read the time. Was it updated properly?+ let u4 = mkSimpleUniverse "wombat" logFileName :: SimpleUniverse TestAgent+ t3 <- evalStateT currentTime u4+ assertEqual "test3" 1 t3++ u5 <- execStateT incTime u4+ t4 <- evalStateT currentTime u5+ assertEqual "test4" 2 t4++ -- Re-read the counter. Was it updated properly?+ let u6 = mkSimpleUniverse "wombat" logFileName :: SimpleUniverse TestAgent+ t5 <- evalStateT currentTime u6+ assertEqual "test5" 2 t5++testUniverseDB :: IO ()+testUniverseDB = withSystemTempDirectory "creaturTest.tmp" testUniverseDB'++testUniverseDB' :: FilePath -> IO ()+testUniverseDB' dir = do+ let logFileName = dir ++ "/universe"+ let u = mkSimpleUniverse "wombat" logFileName :: SimpleUniverse TestAgent+ let a = TestAgent "agent_a" True+ u2 <- execStateT (store a) u+ xs <- evalStateT agentIds u2+ assertBool "agent not in agentIds list" ((A.agentId a) `elem` xs)+ let a2 = a { aIsAlive=False }+ u3 <- execStateT (store a2) u2+ xs' <- evalStateT agentIds u3+ assertBool "agent still in agentIds list" ((A.agentId a) `notElem` xs')+ let f = logFileName ++ "/db/" ++ A.agentId a+ fileExists <- doesFileExist f+ assertBool "agent file not removed" (not fileExists)+ let f2 = logFileName ++ "/db/archive/" ++ A.agentId a+ fileExists2 <- doesFileExist f2+ assertBool "agent file not archived" (fileExists2)++testUniverseLineup :: IO ()+testUniverseLineup = withSystemTempDirectory "creaturTest.tmp" testUniverseLineup'++testUniverseLineup' :: FilePath -> IO ()+testUniverseLineup' dir = do+ let logFileName = dir ++ "/universe"+ let u = mkSimpleUniverse "wombat" logFileName :: SimpleUniverse TestAgent+ let a = TestAgent "agent_a" True+ let b = TestAgent "agent_b" True+ let c = TestAgent "agent_c" True+ u2 <- execStateT (store a >> store b >> store c >> refreshLineup) u+ xs <- evalStateT lineup u2+ assertBool "agent not in lineup" ((A.agentId a) `elem` xs)+ let a2 = a { aIsAlive=False }+ u3 <- execStateT (store a2 >> markDone (A.agentId a2)) u2+ xs' <- evalStateT lineup u3+ assertBool "agent still in lineup" ((A.agentId a) `notElem` xs')++test :: TF.Test+test = testGroup "HUnit ALife.Creatur.UniverseQC"+ [+ testCase "testUniverseCreation" testUniverseCreation,+ testCase "testUniverseDB" testUniverseDB,+ testCase "testUniverseLineup" testUniverseLineup+ ]++