-- Top-level run function for executing and printing solutions.
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 ()