creatur 5.9.20 → 5.9.22

raw patch · 6 files changed

+51/−8 lines, 6 files

Files

• creatur.cabal +14/−1
• src/ALife/Creatur/Database.hs +9/−0
• src/ALife/Creatur/Database/FileSystem.hs +0/−1
• src/ALife/Creatur/Task.hs +3/−1
• test/ALife/Creatur/Genetics/BRGCBoolQC.hs +12/−2
• test/ALife/Creatur/Genetics/BRGCWord16QC.hs +13/−3

@@ -1,5 +1,5 @@ name: creatur-version: 5.9.20+version: 5.9.22 cabal-version: >=1.8 build-type: Simple license: BSD3@@ -120,3 +120,16 @@         ALife.Creatur.UniverseQC         ALife.Creatur.UtilQC     ghc-options: -Wall+++-- Benchmark creatur-bench+--   Type:             exitcode-stdio-1.0+--   Main-is:          BenchAll.hs+--   GHC-Options:      -Wall+--   Hs-source-dirs:   test+--   Build-Depends:+--                     base,+--                     creatur,+--                     criterion,+--                     test-framework+--   Other-modules:    ALife.Creatur.Genetics.BRGCWord8Bench

@@ -19,6 +19,7 @@     SizedRecord(..)  ) where +import Prelude hiding (lookup) import Control.Monad.State (StateT) import Data.Serialize (Serialize) @@ -44,6 +45,14 @@   -- | Read an archived record from the database.   lookupInArchive :: Serialize (DBRecord d) =>      String -> StateT d IO (Either String (DBRecord d))+  -- | Fetch all active records from the database.+  readAll :: Serialize (DBRecord d) => +    StateT d IO [Either String (DBRecord d)]+  readAll = keys >>= mapM lookup+  -- | Read all archived records from the database.+  readAllInArchive :: Serialize (DBRecord d) => +    StateT d IO [Either String (DBRecord d)]+  readAllInArchive = archivedKeys >>= mapM lookupInArchive   -- | Write a record to the database.    --   If an agent with the same name already exists, it will be overwritten.   store :: (Record (DBRecord d), Serialize (DBRecord d)) => 

@@ -125,4 +125,3 @@ isRecordFileName :: String -> Bool isRecordFileName s =   s `notElem` [ "archive", ".", ".." ]-

@@ -45,6 +45,7 @@ import Control.Monad.State (StateT, execStateT, evalStateT) import Control.Monad.Trans.Class (lift) import Data.Serialize (Serialize)+import GHC.Stack (callStack, prettyCallStack)  simpleJob :: Universe u => Job u simpleJob = Job@@ -106,8 +107,9 @@   atEndOfRound endRoundProgram  reportException :: Universe u => SomeException -> StateT u IO ()-reportException e =+reportException e = do   writeToLog $ "WARNING: Unhandled exception: " ++ show e+  writeToLog $ "WARNING: Call stack: " ++ prettyCallStack callStack  checkPopSize :: Universe u => (Int, Int) -> StateT u IO () checkPopSize (minAgents, maxAgents) = do

@@ -25,8 +25,8 @@ import GHC.Generics (Generic) import Test.Framework as TF (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary, choose,-  oneof, property, sized, vectorOf)+import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary,+  choose, oneof, property, sized, vectorOf)  #if MIN_VERSION_base(4,8,0) #else@@ -72,6 +72,16 @@       (prop_round_trippable :: Word8 -> Property),     testProperty "prop_round_trippable - Word16"       (prop_round_trippable :: Word16 -> Property),+    -- testProperty "prop_round_trippable - Word32"+    --   (prop_round_trippable :: Word32 -> Property),+    -- testProperty "prop_round_trippable - Word64"+    --   (prop_round_trippable :: Word64 -> Property),+    -- testProperty "prop_round_trippable - Int"+    --   (prop_round_trippable :: Int -> Property),+    -- testProperty "prop_round_trippable - Integer"+    --   (prop_round_trippable :: Integer -> Property),+    -- testProperty "prop_round_trippable - Double"+    --   (prop_round_trippable :: Double -> Property),     testProperty "prop_round_trippable - TestStructure"       (prop_round_trippable :: TestStructure -> Property)   ]

@@ -25,8 +25,8 @@ import GHC.Generics (Generic) import Test.Framework as TF (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary, choose,-  oneof, property, sized, vectorOf)+import Test.QuickCheck (Arbitrary, Gen, Property, arbitrary,+  choose, oneof, property, sized, vectorOf)  #if MIN_VERSION_base(4,8,0) #else@@ -38,7 +38,7 @@   where x = write g         g' = read x -data TestStructure = A | B Bool | C Word16 | D Word8 Char | E [TestStructure]+data TestStructure = A | B Bool | C Word8 | D Word16 Char | E [TestStructure]   deriving (Show, Eq, Generic)  instance Genetic TestStructure@@ -72,6 +72,16 @@       (prop_round_trippable :: Word8 -> Property),     testProperty "prop_round_trippable - Word16"       (prop_round_trippable :: Word16 -> Property),+    -- testProperty "prop_round_trippable - Word32"+    --   (prop_round_trippable :: Word32 -> Property),+    -- testProperty "prop_round_trippable - Word64"+    --   (prop_round_trippable :: Word64 -> Property),+    testProperty "prop_round_trippable - Int"+      (prop_round_trippable :: Int -> Property),+    -- testProperty "prop_round_trippable - Integer"+    --   (prop_round_trippable :: Integer -> Property),+    -- testProperty "prop_round_trippable - Double"+    --   (prop_round_trippable :: Double -> Property),     testProperty "prop_round_trippable - TestStructure"       (prop_round_trippable :: TestStructure -> Property)   ]