module LogicGrowsOnTrees.Workload
(
Workload(..)
, entire_workload
, workloadDepth
, exploreTreeWithinWorkload
, exploreTreeTWithinWorkload
, exploreTreeUntilFirstWithinWorkload
, exploreTreeTUntilFirstWithinWorkload
, exploreTreeUntilFoundWithinWorkload
, exploreTreeTUntilFoundWithinWorkload
) where
import Control.Monad ((>=>))
import Data.Derive.Serialize
import Data.DeriveTH
import Data.Function (on)
import Data.Monoid (Monoid(..))
import qualified Data.Sequence as Seq
import Data.Serialize
import LogicGrowsOnTrees
import LogicGrowsOnTrees.Checkpoint
import LogicGrowsOnTrees.Path
data Workload = Workload
{ workloadPath :: Path
, workloadCheckpoint :: Checkpoint
} deriving (Eq,Show)
$( derive makeSerialize ''Workload )
instance Ord Workload where
x `compare` y =
case (compare `on` workloadDepth) x y of
EQ → case (compare `on` workloadPath) x y of
EQ → (compare `on` workloadCheckpoint) x y
c → c
c → c
entire_workload :: Workload
entire_workload = Workload Seq.empty Unexplored
workloadDepth :: Workload → Int
workloadDepth = Seq.length . workloadPath
exploreTreeWithinWorkload ::
Monoid α ⇒
Workload →
Tree α →
α
exploreTreeWithinWorkload Workload{..} =
exploreTreeStartingFromCheckpoint workloadCheckpoint
.
sendTreeDownPath workloadPath
exploreTreeTWithinWorkload ::
(Monad m, Monoid α) ⇒
Workload →
TreeT m α →
m α
exploreTreeTWithinWorkload Workload{..} =
sendTreeTDownPath workloadPath
>=>
exploreTreeTStartingFromCheckpoint workloadCheckpoint
exploreTreeUntilFirstWithinWorkload ::
Workload →
Tree α →
Maybe α
exploreTreeUntilFirstWithinWorkload Workload{..} =
exploreTreeUntilFirstStartingFromCheckpoint workloadCheckpoint
.
sendTreeDownPath workloadPath
exploreTreeTUntilFirstWithinWorkload ::
Monad m ⇒
Workload →
TreeT m α →
m (Maybe α)
exploreTreeTUntilFirstWithinWorkload Workload{..} =
sendTreeTDownPath workloadPath
>=>
exploreTreeTUntilFirstStartingFromCheckpoint workloadCheckpoint
exploreTreeUntilFoundWithinWorkload ::
Monoid α ⇒
(α → Bool) →
Workload →
Tree α →
(α,Bool)
exploreTreeUntilFoundWithinWorkload condition Workload{..} =
exploreTreeUntilFoundStartingFromCheckpoint condition workloadCheckpoint
.
sendTreeDownPath workloadPath
exploreTreeTUntilFoundWithinWorkload ::
(Monoid α, Monad m) ⇒
(α → Bool) →
Workload →
TreeT m α →
m (α,Bool)
exploreTreeTUntilFoundWithinWorkload condition Workload{..} =
sendTreeTDownPath workloadPath
>=>
exploreTreeTUntilFoundStartingFromCheckpoint condition workloadCheckpoint