module Dovin.Runner
( run
) where
import System.Exit
import Data.List (groupBy, sort, sortBy)
import Data.Ord (comparing)
import Data.Function (on)
import Dovin.Prelude
import Dovin.Monad
import Dovin.Types
run :: (Step -> Formatter) -> GameMonad () -> IO ()
run :: (Step -> Formatter) -> GameMonad () -> IO ()
run Step -> Formatter
formatter GameMonad ()
solution = do
let (Either String ()
e, Board
_, [Step]
log) = Board -> GameMonad () -> (Either String (), Board, [Step])
forall a. Board -> GameMonad a -> (Either String a, Board, [Step])
runMonad Board
emptyBoard GameMonad ()
solution
let groupedSteps :: [[Step]]
groupedSteps =
(Step -> Step -> Bool) -> [Step] -> [[Step]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe String -> Maybe String -> Bool)
-> (Step -> Maybe String) -> Step -> Step -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting (Maybe String) Step (Maybe String) -> Step -> Maybe String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) Step (Maybe String)
Lens' Step (Maybe String)
stepFork) ([Step] -> [[Step]]) -> ([Step] -> [Step]) -> [Step] -> [[Step]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Step -> Step -> Ordering) -> [Step] -> [Step]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Step -> StepIdentifier) -> Step -> Step -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Step -> StepIdentifier) -> Step -> Step -> Ordering)
-> (Step -> StepIdentifier) -> Step -> Step -> Ordering
forall a b. (a -> b) -> a -> b
$ Getting StepIdentifier Step StepIdentifier
-> Step -> StepIdentifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting StepIdentifier Step StepIdentifier
Lens' Step StepIdentifier
stepId ) ([Step] -> [[Step]]) -> [Step] -> [[Step]]
forall a b. (a -> b) -> a -> b
$ [Step]
log
[[Step]] -> ([Step] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Step]]
groupedSteps (([Step] -> IO ()) -> IO ()) -> ([Step] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Step]
steps -> do
case Getting (Maybe String) Step (Maybe String) -> Step -> Maybe String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) Step (Maybe String)
Lens' Step (Maybe String)
stepFork (Step -> Maybe String) -> Step -> Maybe String
forall a b. (a -> b) -> a -> b
$ [Step] -> Step
forall a. [a] -> a
head [Step]
steps of
Just String
l -> do
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"=== ALTERNATIVE: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
l
String -> IO ()
putStrLn String
""
Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Step] -> (Step -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Step]
steps ((Step -> IO ()) -> IO ()) -> (Step -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Step
step -> do
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Getting Int Step Int -> Step -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Step Int
Lens' Step Int
stepNumber Step
step) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". "
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Getting String Step String -> Step -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Step String
Lens' Step String
stepLabel Step
step
String -> IO ()
putStrLn (String -> IO ()) -> (Step -> String) -> Step -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Step -> Formatter
formatter Step
step Formatter -> (Step -> Board) -> Step -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Board Step Board -> Step -> Board
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Board Step Board
Lens' Step Board
stepState (Step -> IO ()) -> Step -> IO ()
forall a b. (a -> b) -> a -> b
$ Step
step
String -> IO ()
putStrLn String
""
case Either String ()
e of
Left String
x -> do
String -> IO ()
putStrLn String
"ERROR:"
String -> IO ()
putStrLn String
x
String -> IO ()
putStrLn String
""
IO ()
forall a. IO a
System.Exit.exitFailure
Right ()
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()