{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}

module Modelling.PetriNet.Pick (
  PickInstance (..),
  checkConfigForPick,
  pickGenerate,
  pickEvaluation,
  pickSolution,
  pickSyntax,
  pickTaskInstance,
  renderPick,
  wrong,
  wrongInstances,
  ) where

import qualified Data.Bimap                       as BM (fromList, lookup)
import qualified Data.Map                         as M (
  elems,
  filter,
  fromList,
  keys,
  foldrWithKey,
  insert,
  )

import Capabilities.Cache               (MonadCache)
import Capabilities.Diagrams            (MonadDiagrams)
import Capabilities.Graphviz            (MonadGraphviz)
import Modelling.Auxiliary.Common (
  Object,
  findFittingRandomElements,
  )
import Modelling.PetriNet.Diagram (
  cacheNet,
  getDefaultNet,
  getNet,
  isNetDrawable,
  )
import Modelling.PetriNet.Types         (
  BasicConfig (..),
  ChangeConfig (..),
  Drawable,
  GraphConfig (..),
  Net (..),
  allDrawSettings,
  checkBasicConfig,
  checkChangeConfig,
  checkGraphLayouts,
  placeNames,
  transitionNames,
  )

import Control.Applicative              (Alternative ((<|>)))
import Control.Arrow                    (Arrow (second))
import Control.Monad.Catch              (MonadCatch, MonadThrow)
import Control.Monad.Extra              (maybeM)
import Control.OutputCapable.Blocks (
  ArticleToUse (DefiniteArticle),
  LangM,
  Language,
  OutputCapable,
  english,
  german,
  singleChoice,
  singleChoiceSyntax,
  translations,
  )
import Control.Monad.Random (
  RandT,
  StdGen,
  evalRandT,
  mkStdGen
  )
import Control.Monad.Trans              (MonadTrans (lift))
import Data.Bitraversable               (bimapM)
import Data.Containers.ListUtils        (nubOrd)
import Data.Data                        (Data, Typeable)
import Data.Map                         (Map)
import Data.Maybe                       (isJust)
import GHC.Generics                     (Generic)
import Language.Alloy.Call (
  AlloyInstance
  )
import System.Random.Shuffle            (shuffleM)

data PickInstance n = PickInstance {
  forall n. PickInstance n -> Map Int (Bool, Drawable n)
nets :: !(Map Int (Bool, Drawable n)),
  forall n. PickInstance n -> Bool
showSolution :: !Bool,
  forall n. PickInstance n -> Maybe (Map Language String)
addText :: !(Maybe (Map Language String))
  }
  deriving ((forall x. PickInstance n -> Rep (PickInstance n) x)
-> (forall x. Rep (PickInstance n) x -> PickInstance n)
-> Generic (PickInstance n)
forall x. Rep (PickInstance n) x -> PickInstance n
forall x. PickInstance n -> Rep (PickInstance n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (PickInstance n) x -> PickInstance n
forall n x. PickInstance n -> Rep (PickInstance n) x
$cfrom :: forall n x. PickInstance n -> Rep (PickInstance n) x
from :: forall x. PickInstance n -> Rep (PickInstance n) x
$cto :: forall n x. Rep (PickInstance n) x -> PickInstance n
to :: forall x. Rep (PickInstance n) x -> PickInstance n
Generic, ReadPrec [PickInstance n]
ReadPrec (PickInstance n)
Int -> ReadS (PickInstance n)
ReadS [PickInstance n]
(Int -> ReadS (PickInstance n))
-> ReadS [PickInstance n]
-> ReadPrec (PickInstance n)
-> ReadPrec [PickInstance n]
-> Read (PickInstance n)
forall n. Read n => ReadPrec [PickInstance n]
forall n. Read n => ReadPrec (PickInstance n)
forall n. Read n => Int -> ReadS (PickInstance n)
forall n. Read n => ReadS [PickInstance n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall n. Read n => Int -> ReadS (PickInstance n)
readsPrec :: Int -> ReadS (PickInstance n)
$creadList :: forall n. Read n => ReadS [PickInstance n]
readList :: ReadS [PickInstance n]
$creadPrec :: forall n. Read n => ReadPrec (PickInstance n)
readPrec :: ReadPrec (PickInstance n)
$creadListPrec :: forall n. Read n => ReadPrec [PickInstance n]
readListPrec :: ReadPrec [PickInstance n]
Read, Int -> PickInstance n -> ShowS
[PickInstance n] -> ShowS
PickInstance n -> String
(Int -> PickInstance n -> ShowS)
-> (PickInstance n -> String)
-> ([PickInstance n] -> ShowS)
-> Show (PickInstance n)
forall n. Show n => Int -> PickInstance n -> ShowS
forall n. Show n => [PickInstance n] -> ShowS
forall n. Show n => PickInstance n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> PickInstance n -> ShowS
showsPrec :: Int -> PickInstance n -> ShowS
$cshow :: forall n. Show n => PickInstance n -> String
show :: PickInstance n -> String
$cshowList :: forall n. Show n => [PickInstance n] -> ShowS
showList :: [PickInstance n] -> ShowS
Show)

-- TODO: replace 'wrong' in 'pickGenerate' by 'wrongInstances'
-- if this value might be greater than 1 on task generation.
wrongInstances :: PickInstance n -> Int
wrongInstances :: forall n. PickInstance n -> Int
wrongInstances PickInstance n
inst = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool
False | (Bool
False, Drawable n
_) <- Map Int (Bool, Drawable n) -> [(Bool, Drawable n)]
forall k a. Map k a -> [a]
M.elems (PickInstance n -> Map Int (Bool, Drawable n)
forall n. PickInstance n -> Map Int (Bool, Drawable n)
nets PickInstance n
inst)]

wrong :: Int
wrong :: Int
wrong = Int
1

pickTaskInstance
  :: (MonadThrow m, Net p n, Traversable t)
  => (AlloyInstance -> m (t Object))
  -> AlloyInstance
  -> m [(p n String, Maybe (t String))]
pickTaskInstance :: forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *)
       (t :: * -> *).
(MonadThrow m, Net p n, Traversable t) =>
(AlloyInstance -> m (t Object))
-> AlloyInstance -> m [(p n String, Maybe (t String))]
pickTaskInstance AlloyInstance -> m (t Object)
parseSpecial AlloyInstance
inst = do
  (p n String, Maybe (t String))
special <- (t String -> Maybe (t String))
-> (p n String, t String) -> (p n String, Maybe (t String))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second t String -> Maybe (t String)
forall a. a -> Maybe a
Just ((p n String, t String) -> (p n String, Maybe (t String)))
-> m (p n String, t String) -> m (p n String, Maybe (t String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlloyInstance -> m (t Object))
-> AlloyInstance -> m (p n String, t String)
forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *)
       (t :: * -> *).
(MonadThrow m, Net p n, Traversable t) =>
(AlloyInstance -> m (t Object))
-> AlloyInstance -> m (p n String, t String)
getNet AlloyInstance -> m (t Object)
parseSpecial AlloyInstance
inst
  (p n String, Maybe (t String))
net   <- (,Maybe (t String)
forall a. Maybe a
Nothing) (p n String -> (p n String, Maybe (t String)))
-> m (p n String) -> m (p n String, Maybe (t String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AlloyInstance -> m (p n String)
forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *).
(MonadThrow m, Net p n) =>
AlloyInstance -> m (p n String)
getDefaultNet AlloyInstance
inst
  [(p n String, Maybe (t String))]
-> m [(p n String, Maybe (t String))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(p n String, Maybe (t String))
special, (p n String, Maybe (t String))
net]

pickGenerate
  :: (MonadCatch m, MonadDiagrams m, MonadGraphviz m, Net p n)
  => (c
    -> Int
    -> RandT StdGen m [(p n String, Maybe a)]
    )
  -> (c -> GraphConfig)
  -> (c -> Bool)
  -> (c -> Bool)
  -> (c -> Maybe (Map Language String))
  -> c
  -> Int
  -> Int
  -> m (PickInstance (p n String))
pickGenerate :: forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *) c a.
(MonadCatch m, MonadDiagrams m, MonadGraphviz m, Net p n) =>
(c -> Int -> RandT StdGen m [(p n String, Maybe a)])
-> (c -> GraphConfig)
-> (c -> Bool)
-> (c -> Bool)
-> (c -> Maybe (Map Language String))
-> c
-> Int
-> Int
-> m (PickInstance (p n String))
pickGenerate c -> Int -> RandT StdGen m [(p n String, Maybe a)]
pick c -> GraphConfig
gc c -> Bool
useDifferent c -> Bool
withSol c -> Maybe (Map Language String)
getExtraText c
config Int
segment Int
seed
  = RandT StdGen m (PickInstance (p n String))
-> StdGen -> m (PickInstance (p n String))
forall (m :: * -> *) g a. Monad m => RandT g m a -> g -> m a
evalRandT RandT StdGen m (PickInstance (p n String))
getInstance (Int -> StdGen
mkStdGen Int
seed)
  where
    getInstance :: RandT StdGen m (PickInstance (p n String))
getInstance = do
      [(p n String, Maybe a)]
ns <- c -> Int -> RandT StdGen m [(p n String, Maybe a)]
pick c
config Int
segment
      [(p n String, Maybe a)]
ns'  <- [(p n String, Maybe a)] -> RandT StdGen m [(p n String, Maybe a)]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [(p n String, Maybe a)]
ns
      let ts :: [String]
ts = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((p n String, Maybe a) -> [String])
-> [(p n String, Maybe a)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (p n String -> [String]
forall (p :: (* -> *) -> * -> *) (n :: * -> *) k.
(Net p n, Ord k) =>
p n k -> [k]
transitionNames (p n String -> [String])
-> ((p n String, Maybe a) -> p n String)
-> (p n String, Maybe a)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p n String, Maybe a) -> p n String
forall a b. (a, b) -> a
fst) [(p n String, Maybe a)]
ns'
          ps :: [String]
ps = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((p n String, Maybe a) -> [String])
-> [(p n String, Maybe a)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (p n String -> [String]
forall (p :: (* -> *) -> * -> *) (n :: * -> *) k.
(Net p n, Ord k) =>
p n k -> [k]
placeNames (p n String -> [String])
-> ((p n String, Maybe a) -> p n String)
-> (p n String, Maybe a)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p n String, Maybe a) -> p n String
forall a b. (a, b) -> a
fst) [(p n String, Maybe a)]
ns'
      [String]
ts' <- [String] -> RandT StdGen m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
ts
      [String]
ps' <- [String] -> RandT StdGen m [String]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM [String]
ps
      let mapping :: Bimap String String
mapping = [(String, String)] -> Bimap String String
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList ([(String, String)] -> Bimap String String)
-> [(String, String)] -> Bimap String String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
ps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ts) ([String]
ps' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ts')
      [(p n String, Maybe a)]
ns'' <- m [(p n String, Maybe a)] -> RandT StdGen m [(p n String, Maybe a)]
forall (m :: * -> *) a. Monad m => m a -> RandT StdGen m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [(p n String, Maybe a)]
 -> RandT StdGen m [(p n String, Maybe a)])
-> m [(p n String, Maybe a)]
-> RandT StdGen m [(p n String, Maybe a)]
forall a b. (a -> b) -> a -> b
$ (p n String -> m (p n String))
-> (Maybe a -> m (Maybe a))
-> (p n String, Maybe a)
-> m (p n String, Maybe a)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM ((String -> m String) -> p n String -> m (p n String)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> p n a -> f (p n b)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) (f :: * -> *) b a.
(Net p n, Applicative f, Ord b) =>
(a -> f b) -> p n a -> f (p n b)
traverseNet (String -> Bimap String String -> m String
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
`BM.lookup` Bimap String String
mapping)) Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((p n String, Maybe a) -> m (p n String, Maybe a))
-> [(p n String, Maybe a)] -> m [(p n String, Maybe a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [(p n String, Maybe a)]
ns'
      [(p n String, Maybe a)]
-> RandT StdGen m (PickInstance (p n String))
getPickInstance [(p n String, Maybe a)]
ns''
    toPickInstance :: [(n, Maybe a)] -> [DrawSettings] -> f (PickInstance n)
toPickInstance [(n, Maybe a)]
ns [DrawSettings]
ds =
      PickInstance n -> f (PickInstance n)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PickInstance n -> f (PickInstance n))
-> PickInstance n -> f (PickInstance n)
forall a b. (a -> b) -> a -> b
$ PickInstance {
        $sel:nets:PickInstance :: Map Int (Bool, Drawable n)
nets = [(Int, (Bool, Drawable n))] -> Map Int (Bool, Drawable n)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
          ([(Int, (Bool, Drawable n))] -> Map Int (Bool, Drawable n))
-> [(Int, (Bool, Drawable n))] -> Map Int (Bool, Drawable n)
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Bool, Drawable n)] -> [(Int, (Bool, Drawable n))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [(Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m, (n
n, DrawSettings
d)) | ((n
n, Maybe a
m), DrawSettings
d) <- [(n, Maybe a)] -> [DrawSettings] -> [((n, Maybe a), DrawSettings)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(n, Maybe a)]
ns [DrawSettings]
ds],
        $sel:showSolution:PickInstance :: Bool
showSolution = c -> Bool
withSol c
config,
        $sel:addText:PickInstance :: Maybe (Map Language String)
addText = c -> Maybe (Map Language String)
getExtraText c
config
        }
    getPickInstance :: [(p n String, Maybe a)]
-> RandT StdGen m (PickInstance (p n String))
getPickInstance [(p n String, Maybe a)]
petriNets =
      let predicates :: [DrawSettings -> RandT StdGen m Bool]
predicates = ((p n String, Maybe a) -> DrawSettings -> RandT StdGen m Bool)
-> [(p n String, Maybe a)] -> [DrawSettings -> RandT StdGen m Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\(p n String
x,Maybe a
_) -> m Bool -> RandT StdGen m Bool
forall (m :: * -> *) a. Monad m => m a -> RandT StdGen m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> RandT StdGen m Bool)
-> (DrawSettings -> m Bool) -> DrawSettings -> RandT StdGen m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p n String -> DrawSettings -> m Bool
forall (m :: * -> *) (p :: (* -> *) -> * -> *) (n :: * -> *).
(MonadCatch m, MonadDiagrams m, MonadGraphviz m, Net p n) =>
p n String -> DrawSettings -> m Bool
isNetDrawable p n String
x) [(p n String, Maybe a)]
petriNets
          availableLayouts :: [DrawSettings]
availableLayouts = GraphConfig -> [DrawSettings]
allDrawSettings (c -> GraphConfig
gc c
config)
      in
        RandT StdGen m (PickInstance (p n String))
-> ([DrawSettings] -> RandT StdGen m (PickInstance (p n String)))
-> RandT StdGen m (Maybe [DrawSettings])
-> RandT StdGen m (PickInstance (p n String))
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM RandT StdGen m (PickInstance (p n String))
getInstance ([(p n String, Maybe a)]
-> [DrawSettings] -> RandT StdGen m (PickInstance (p n String))
forall {f :: * -> *} {n} {a}.
Applicative f =>
[(n, Maybe a)] -> [DrawSettings] -> f (PickInstance n)
toPickInstance [(p n String, Maybe a)]
petriNets)
        (RandT StdGen m (Maybe [DrawSettings])
 -> RandT StdGen m (PickInstance (p n String)))
-> RandT StdGen m (Maybe [DrawSettings])
-> RandT StdGen m (PickInstance (p n String))
forall a b. (a -> b) -> a -> b
$ Bool
-> [DrawSettings]
-> [DrawSettings -> RandT StdGen m Bool]
-> RandT StdGen m (Maybe [DrawSettings])
forall (m :: * -> *) a.
MonadRandom m =>
Bool -> [a] -> [a -> m Bool] -> m (Maybe [a])
findFittingRandomElements (c -> Bool
useDifferent c
config) [DrawSettings]
availableLayouts [DrawSettings -> RandT StdGen m Bool]
predicates

pickSyntax
  :: OutputCapable m
  => PickInstance n
  -> Int
  -> LangM m
pickSyntax :: forall (m :: * -> *) n.
OutputCapable m =>
PickInstance n -> Int -> LangM m
pickSyntax PickInstance n
task = Bool -> [Int] -> Int -> LangM m
forall (m :: * -> *) a.
(OutputCapable m, Eq a, Show a) =>
Bool -> [a] -> a -> LangM m
singleChoiceSyntax Bool
withSol [Int]
options
  where
    options :: [Int]
options = Map Int (Bool, Drawable n) -> [Int]
forall k a. Map k a -> [k]
M.keys (Map Int (Bool, Drawable n) -> [Int])
-> Map Int (Bool, Drawable n) -> [Int]
forall a b. (a -> b) -> a -> b
$ PickInstance n -> Map Int (Bool, Drawable n)
forall n. PickInstance n -> Map Int (Bool, Drawable n)
nets PickInstance n
task
    withSol :: Bool
withSol = PickInstance n -> Bool
forall n. PickInstance n -> Bool
showSolution PickInstance n
task

pickEvaluation
  :: OutputCapable m
  => PickInstance n
  -> Int
  -> LangM m
pickEvaluation :: forall (m :: * -> *) n.
OutputCapable m =>
PickInstance n -> Int -> LangM m
pickEvaluation PickInstance n
task = do
  let what :: Map Language String
what = State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
        String -> State (Map Language String) ()
english String
"Petri net"
        String -> State (Map Language String) ()
german String
"Petrinetz"
  ArticleToUse
-> Map Language String -> Maybe String -> Int -> Int -> LangM m
forall (m :: * -> *) a.
(OutputCapable m, Eq a) =>
ArticleToUse
-> Map Language String -> Maybe String -> a -> a -> LangM m
singleChoice ArticleToUse
DefiniteArticle Map Language String
what Maybe String
maybeSolutionString Int
solution
  where
    maybeSolutionString :: Maybe String
maybeSolutionString =
      if Bool
withSol
      then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
solution
      else Maybe String
forall a. Maybe a
Nothing
    solution :: Int
solution = PickInstance n -> Int
forall n. PickInstance n -> Int
pickSolution PickInstance n
task
    withSol :: Bool
withSol = PickInstance n -> Bool
forall n. PickInstance n -> Bool
showSolution PickInstance n
task

pickSolution :: PickInstance n -> Int
pickSolution :: forall n. PickInstance n -> Int
pickSolution = [Int] -> Int
forall a. HasCallStack => [a] -> a
head ([Int] -> Int)
-> (PickInstance n -> [Int]) -> PickInstance n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int (Bool, Drawable n) -> [Int]
forall k a. Map k a -> [k]
M.keys (Map Int (Bool, Drawable n) -> [Int])
-> (PickInstance n -> Map Int (Bool, Drawable n))
-> PickInstance n
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, Drawable n) -> Bool)
-> Map Int (Bool, Drawable n) -> Map Int (Bool, Drawable n)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool, Drawable n) -> Bool
forall a b. (a, b) -> a
fst (Map Int (Bool, Drawable n) -> Map Int (Bool, Drawable n))
-> (PickInstance n -> Map Int (Bool, Drawable n))
-> PickInstance n
-> Map Int (Bool, Drawable n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PickInstance n -> Map Int (Bool, Drawable n)
forall n. PickInstance n -> Map Int (Bool, Drawable n)
nets

renderPick
  :: (
    Data (n String),
    Data (p n String),
    MonadCache m,
    MonadDiagrams m,
    MonadGraphviz m,
    MonadThrow m,
    Net p n,
    Typeable n,
    Typeable p
    )
  => FilePath
  -> PickInstance (p n String)
  -> m (Map Int (Bool, String))
renderPick :: forall (n :: * -> *) (p :: (* -> *) -> * -> *) (m :: * -> *).
(Data (n String), Data (p n String), MonadCache m, MonadDiagrams m,
 MonadGraphviz m, MonadThrow m, Net p n, Typeable n, Typeable p) =>
String -> PickInstance (p n String) -> m (Map Int (Bool, String))
renderPick String
path PickInstance (p n String)
config =
  (Int
 -> (Bool, (p n String, DrawSettings))
 -> m (Map Int (Bool, String))
 -> m (Map Int (Bool, String)))
-> m (Map Int (Bool, String))
-> Map Int (Bool, (p n String, DrawSettings))
-> m (Map Int (Bool, String))
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey Int
-> (Bool, (p n String, DrawSettings))
-> m (Map Int (Bool, String))
-> m (Map Int (Bool, String))
forall {m :: * -> *} {n :: * -> *} {p :: (* -> *) -> * -> *} {k}
       {a}.
(Data (n String), Data (p n String), MonadCache m, MonadDiagrams m,
 MonadGraphviz m, MonadThrow m, Net p n, Typeable p, Typeable n,
 Ord k) =>
k
-> (a, (p n String, DrawSettings))
-> m (Map k (a, String))
-> m (Map k (a, String))
render' (Map Int (Bool, String) -> m (Map Int (Bool, String))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Int (Bool, String)
forall a. Monoid a => a
mempty) (Map Int (Bool, (p n String, DrawSettings))
 -> m (Map Int (Bool, String)))
-> Map Int (Bool, (p n String, DrawSettings))
-> m (Map Int (Bool, String))
forall a b. (a -> b) -> a -> b
$ PickInstance (p n String)
-> Map Int (Bool, (p n String, DrawSettings))
forall n. PickInstance n -> Map Int (Bool, Drawable n)
nets PickInstance (p n String)
config
  where
    render' :: k
-> (a, (p n String, DrawSettings))
-> m (Map k (a, String))
-> m (Map k (a, String))
render' k
x (a
b, (p n String
net, DrawSettings
ds)) m (Map k (a, String))
ns =
      String -> p n String -> DrawSettings -> m String
forall (n :: * -> *) (p :: (* -> *) -> * -> *) (m :: * -> *).
(Data (n String), Data (p n String), MonadCache m, MonadDiagrams m,
 MonadGraphviz m, MonadThrow m, Net p n, Typeable n, Typeable p) =>
String -> p n String -> DrawSettings -> m String
cacheNet String
path p n String
net DrawSettings
ds
      m String
-> (String -> m (Map k (a, String))) -> m (Map k (a, String))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
file -> k -> (a, String) -> Map k (a, String) -> Map k (a, String)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
x (a
b, String
file) (Map k (a, String) -> Map k (a, String))
-> m (Map k (a, String)) -> m (Map k (a, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Map k (a, String))
ns

checkConfigForPick
  :: Bool
  -> Int
  -> BasicConfig
  -> ChangeConfig
  -> GraphConfig
  -> Maybe String
checkConfigForPick :: Bool
-> Int
-> BasicConfig
-> ChangeConfig
-> GraphConfig
-> Maybe String
checkConfigForPick Bool
useDifferent Int
numWrongInstances BasicConfig
basic ChangeConfig
change GraphConfig
graph
  = BasicConfig -> Maybe String
checkBasicConfig BasicConfig
basic
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BasicConfig -> ChangeConfig -> Maybe String
checkChangeConfig BasicConfig
basic ChangeConfig
change
  Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Int -> GraphConfig -> Maybe String
checkGraphLayouts Bool
useDifferent Int
numWrongInstances GraphConfig
graph