module Coadjute.Main (coadjute) where
import Control.Monad (when)
import Data.Function (on)
import Data.Graph.Inductive (noNodes)
import Text.Printf (printf)
import Coadjute.CoData
import Coadjute.DB (loadDataBase, writeDataBase)
import Coadjute.Rule (Coadjute, runCoadjute, rTasks)
import Coadjute.Task
import Coadjute.Task.Perform (performTasks)
import Coadjute.Task.Required (splitUnnecessary)
import Coadjute.Util.List (fullGroupBy, nubSplitBy)
coadjute :: Coadjute a -> IO a
coadjute st = runCoData $ do
verbosity <- asks coVerbosity
(rules,ret) <- runCoadjute st
let allTasks = concatMap rTasks rules
db <- loadDataBase
let (reasonableTasks, conflicts) = nubSplitBy sameTarget allTasks
putTaskGroups "Conflicting rules:" conflicts
(possibleTasks, impossibles) <- splitImpossibles reasonableTasks
putTasks "Unsatisfiable dependencies:" impossibles
let (doableTaskGraph, cycles) = splitCycles possibleTasks
putTaskGroups "Cycles in rules:" cycles
when (verbosity >= Verbose).io $
printf "Built graph containing %d possible tasks.\n"
(noNodes doableTaskGraph)
(finalTaskGraph,pointless,db') <- splitUnnecessary db doableTaskGraph
when (verbosity >= Verbose).io $
printf "%d tasks are unnecessary.\n"
(noNodes doableTaskGraph noNodes finalTaskGraph)
when (verbosity >= VeryVerbose) $
putTasks "Unnecessary tasks:" pointless
performTasks finalTaskGraph
writeDataBase db'
return ret
putTaskGroups :: MonadIO m => String -> [[Task]] -> m ()
putTaskGroups _ [] = return ()
putTaskGroups s xs = do
io$ putStrLn s
mapM_ putTasks' xs
putTasks :: MonadIO m => String -> [Task] -> m ()
putTasks _ [] = return ()
putTasks s xs = do
io$ putStrLn s
putTasks' xs
putTasks' :: MonadIO m => [Task] -> m ()
putTasks' [] = return ()
putTasks' xs = io$
mapM_
(\ts -> do
putStrLn $ "\tIn rule '" ++ tName (head ts) ++ "':"
mapM_ (putStrLn.("\t\t"++).showTask) ts
)
(fullGroupBy ((==) `on` tName) xs)