{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Goblin.Explainer where import Control.Monad.Trans.State.Strict (runState) import Control.Monad.Trans.Maybe (runMaybeT) import Data.TreeDiff import Hedgehog import qualified Hedgehog.Range as Range import qualified Hedgehog.Internal.Gen as IGen import qualified Hedgehog.Internal.Tree as ITree import Moo.GeneticAlgorithm.Types (Population) import Test.Goblin.Core explainGoblin :: (Goblin Bool s, ToExpr s) => s -> GoblinData Bool -> Maybe (Edit EditExpr, GoblinData Bool) explainGoblin :: s -> GoblinData Bool -> Maybe (Edit EditExpr, GoblinData Bool) explainGoblin s sig GoblinData Bool goblin = Tree (Maybe (Edit EditExpr, GoblinData Bool)) -> Maybe (Edit EditExpr, GoblinData Bool) forall a. Tree a -> a ITree.treeValue (Tree (Maybe (Edit EditExpr, GoblinData Bool)) -> Maybe (Edit EditExpr, GoblinData Bool)) -> (GenT Identity (Edit EditExpr, GoblinData Bool) -> Tree (Maybe (Edit EditExpr, GoblinData Bool))) -> GenT Identity (Edit EditExpr, GoblinData Bool) -> Maybe (Edit EditExpr, GoblinData Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . MaybeT (TreeT Identity) (Edit EditExpr, GoblinData Bool) -> Tree (Maybe (Edit EditExpr, GoblinData Bool)) forall (m :: * -> *) a. MaybeT m a -> m (Maybe a) runMaybeT (MaybeT (TreeT Identity) (Edit EditExpr, GoblinData Bool) -> Tree (Maybe (Edit EditExpr, GoblinData Bool))) -> (GenT Identity (Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (Edit EditExpr, GoblinData Bool)) -> GenT Identity (Edit EditExpr, GoblinData Bool) -> Tree (Maybe (Edit EditExpr, GoblinData Bool)) forall b c a. (b -> c) -> (a -> b) -> a -> c . TreeT (MaybeT Identity) (Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (Edit EditExpr, GoblinData Bool) forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransDistributive g, Transformer f g m) => g (f m) a -> f (g m) a distributeT (TreeT (MaybeT Identity) (Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (Edit EditExpr, GoblinData Bool)) -> (GenT Identity (Edit EditExpr, GoblinData Bool) -> TreeT (MaybeT Identity) (Edit EditExpr, GoblinData Bool)) -> GenT Identity (Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (Edit EditExpr, GoblinData Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . Size -> Seed -> GenT Identity (Edit EditExpr, GoblinData Bool) -> TreeT (MaybeT Identity) (Edit EditExpr, GoblinData Bool) forall (m :: * -> *) a. Size -> Seed -> GenT m a -> TreeT (MaybeT m) a IGen.runGenT Size genSize Seed genSeed (GenT Identity (Edit EditExpr, GoblinData Bool) -> Maybe (Edit EditExpr, GoblinData Bool)) -> GenT Identity (Edit EditExpr, GoblinData Bool) -> Maybe (Edit EditExpr, GoblinData Bool) forall a b. (a -> b) -> a -> b $ do let (Gen s newSigGen, GoblinData Bool finalGoblin) = State (GoblinData Bool) (Gen s) -> GoblinData Bool -> (Gen s, GoblinData Bool) forall s a. State s a -> s -> (a, s) runState (Gen s -> State (GoblinData Bool) (Gen s) forall g a. Goblin g a => Gen a -> TinkerM g (Gen a) tinker (s -> Gen s forall (f :: * -> *) a. Applicative f => a -> f a pure s sig)) GoblinData Bool goblin s newSig <- Gen s newSigGen (Edit EditExpr, GoblinData Bool) -> GenT Identity (Edit EditExpr, GoblinData Bool) forall (f :: * -> *) a. Applicative f => a -> f a pure ((Edit EditExpr, GoblinData Bool) -> GenT Identity (Edit EditExpr, GoblinData Bool)) -> (Edit EditExpr, GoblinData Bool) -> GenT Identity (Edit EditExpr, GoblinData Bool) forall a b. (a -> b) -> a -> b $ (s -> s -> Edit EditExpr forall a. ToExpr a => a -> a -> Edit EditExpr ediff s sig s newSig, GoblinData Bool finalGoblin) where genSize :: Size genSize = Int -> Size Range.Size Int 1 genSeed :: Seed genSeed = Word64 -> Word64 -> Seed Seed Word64 12345 Word64 12345 explainGoblinGen :: (Goblin Bool s, ToExpr s) => Maybe Size -> Maybe Seed -> Gen s -> GoblinData Bool -> Maybe (s, s, Edit EditExpr, GoblinData Bool) explainGoblinGen :: Maybe Size -> Maybe Seed -> Gen s -> GoblinData Bool -> Maybe (s, s, Edit EditExpr, GoblinData Bool) explainGoblinGen Maybe Size mbSize Maybe Seed mbSeed Gen s sigGen GoblinData Bool goblin = Tree (Maybe (s, s, Edit EditExpr, GoblinData Bool)) -> Maybe (s, s, Edit EditExpr, GoblinData Bool) forall a. Tree a -> a ITree.treeValue (Tree (Maybe (s, s, Edit EditExpr, GoblinData Bool)) -> Maybe (s, s, Edit EditExpr, GoblinData Bool)) -> (GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> Tree (Maybe (s, s, Edit EditExpr, GoblinData Bool))) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> Maybe (s, s, Edit EditExpr, GoblinData Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . MaybeT (TreeT Identity) (s, s, Edit EditExpr, GoblinData Bool) -> Tree (Maybe (s, s, Edit EditExpr, GoblinData Bool)) forall (m :: * -> *) a. MaybeT m a -> m (Maybe a) runMaybeT (MaybeT (TreeT Identity) (s, s, Edit EditExpr, GoblinData Bool) -> Tree (Maybe (s, s, Edit EditExpr, GoblinData Bool))) -> (GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (s, s, Edit EditExpr, GoblinData Bool)) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> Tree (Maybe (s, s, Edit EditExpr, GoblinData Bool)) forall b c a. (b -> c) -> (a -> b) -> a -> c . TreeT (MaybeT Identity) (s, s, Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (s, s, Edit EditExpr, GoblinData Bool) forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransDistributive g, Transformer f g m) => g (f m) a -> f (g m) a distributeT (TreeT (MaybeT Identity) (s, s, Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (s, s, Edit EditExpr, GoblinData Bool)) -> (GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> TreeT (MaybeT Identity) (s, s, Edit EditExpr, GoblinData Bool)) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> MaybeT (TreeT Identity) (s, s, Edit EditExpr, GoblinData Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . Size -> Seed -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> TreeT (MaybeT Identity) (s, s, Edit EditExpr, GoblinData Bool) forall (m :: * -> *) a. Size -> Seed -> GenT m a -> TreeT (MaybeT m) a IGen.runGenT Size genSize Seed genSeed (GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> Maybe (s, s, Edit EditExpr, GoblinData Bool)) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) -> Maybe (s, s, Edit EditExpr, GoblinData Bool) forall a b. (a -> b) -> a -> b $ do s sig <- Gen s sigGen let (Gen s newSigGen, GoblinData Bool finalGoblin) = State (GoblinData Bool) (Gen s) -> GoblinData Bool -> (Gen s, GoblinData Bool) forall s a. State s a -> s -> (a, s) runState (Gen s -> State (GoblinData Bool) (Gen s) forall g a. Goblin g a => Gen a -> TinkerM g (Gen a) tinker (s -> Gen s forall (f :: * -> *) a. Applicative f => a -> f a pure s sig)) GoblinData Bool goblin s newSig <- Gen s newSigGen (s, s, Edit EditExpr, GoblinData Bool) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) forall (f :: * -> *) a. Applicative f => a -> f a pure ((s, s, Edit EditExpr, GoblinData Bool) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool)) -> (s, s, Edit EditExpr, GoblinData Bool) -> GenT Identity (s, s, Edit EditExpr, GoblinData Bool) forall a b. (a -> b) -> a -> b $ (s sig, s newSig, s -> s -> Edit EditExpr forall a. ToExpr a => a -> a -> Edit EditExpr ediff s sig s newSig, GoblinData Bool finalGoblin) where genSize :: Size genSize = case Maybe Size mbSize of Maybe Size Nothing -> Int -> Size Range.Size Int 1 Just Size sz -> Size sz genSeed :: Seed genSeed = case Maybe Seed mbSeed of Maybe Seed Nothing -> Word64 -> Word64 -> Seed Seed Word64 12345 Word64 12345 Just Seed sd -> Seed sd explainGoblinGenFromFile :: (Goblin Bool s, ToExpr s) => Maybe Size -> Maybe Seed -> Gen s -> FilePath -> IO (Maybe (s, s, Edit EditExpr, GoblinData Bool)) explainGoblinGenFromFile :: Maybe Size -> Maybe Seed -> Gen s -> FilePath -> IO (Maybe (s, s, Edit EditExpr, GoblinData Bool)) explainGoblinGenFromFile Maybe Size mbSize Maybe Seed mbSeed Gen s sigGen FilePath fp = do FilePath str <- FilePath -> IO FilePath readFile FilePath fp Population Bool pop <- case ReadS (Population Bool) forall a. Read a => ReadS a reads FilePath str :: [(Population Bool,String)] of [(Population Bool pop,FilePath "")] -> Population Bool -> IO (Population Bool) forall (f :: * -> *) a. Applicative f => a -> f a pure Population Bool pop [(Population Bool, FilePath)] _ -> FilePath -> IO (Population Bool) forall a. HasCallStack => FilePath -> a error (FilePath "couldn't parse file: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath fp) let bestGenome :: Genome Bool bestGenome = case Population Bool pop of [] -> FilePath -> Genome Bool forall a. HasCallStack => FilePath -> a error FilePath "empty population" ((Genome Bool best,Objective _score):Population Bool _) -> Genome Bool best let goblin :: GoblinData Bool goblin = Genome Bool -> GoblinData Bool forall g. Genome g -> GoblinData g mkEmptyGoblin Genome Bool bestGenome Maybe (s, s, Edit EditExpr, GoblinData Bool) -> IO (Maybe (s, s, Edit EditExpr, GoblinData Bool)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Size -> Maybe Seed -> Gen s -> GoblinData Bool -> Maybe (s, s, Edit EditExpr, GoblinData Bool) forall s. (Goblin Bool s, ToExpr s) => Maybe Size -> Maybe Seed -> Gen s -> GoblinData Bool -> Maybe (s, s, Edit EditExpr, GoblinData Bool) explainGoblinGen Maybe Size mbSize Maybe Seed mbSeed Gen s sigGen GoblinData Bool goblin)