{-# 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)