-- File created: 2008-01-27 14:58:50

module Coadjute.Task(
   Source, Target,
   Task(..), showTask, sameTarget,
   TaskGraph,
   splitImpossibles, splitCycles
) where

import Control.Exception    (assert)
import Control.Monad        (filterM)
import Data.Graph.Inductive (Gr, delNodes, lab, scc, mkGraph)
import Data.List            (findIndex)
import Data.Maybe           (fromJust)
import Data.Set             (Set)
import qualified Data.Set as Set

import Coadjute.CoData
import Coadjute.Util.File  (allPathsExist)
import Coadjute.Util.List  (length1)

type Source = FilePath
type Target = FilePath

-- |An Task represents the process of building a target.
data Task =
   Task {
      -- |The name of the Rule where the Task is from.
      tName :: String,
      -- |Any command line arguments which the build action may use. Archived
      -- in the database so that changed args incite a rebuild.
      --
      -- TODO: support more than just Strings, arbitrary OptDescr would be
      -- nice.
      tArgs :: Set String,
      -- |The target(s) which the Task will build. If there are more than one,
      -- they are all built by the action simultaneously.
      tTargets :: [Target],
      -- |The dependencies which must be satisfied before the Task can be
      -- performed.
      tDeps :: [Source],
      -- |The action, which builds the target on the assumption that the
      -- dependencies have been satisfied.
      tAction :: IO ()
   }

-- |Tasks can't be Show since the tAction can't be output meaningfully. This is
-- the next-best thing.
showTask :: Task -> String
showTask Task {tTargets = t, tDeps = d, tArgs = a} =
   concat
      [ "Task { tTargets = ", show t
      ,      ", tDeps = ",    show d
      ,      ", tArgs = ",    show a
      ,      " }"
      ]

sameTarget :: Task -> Task -> Bool
sameTarget (Task {tTargets=ts}) (Task {tTargets=tz}) = any (`elem` ts) tz

-- Tasks can't be Eq since two Tasks may be the same in every way except for
-- the tAction, which isn't Eq.
--
-- So we define and use these instead, which compare only the targets. We can
-- do that since we can assume that sameTarget-Tasks have been removed before
-- we need to call this on them.
--
-- An assertion is there just in case.
(=~=), (!~=) :: Task -> Task -> Bool
Task {tName = n, tTargets = t, tDeps = d}
   =~= Task {tName = n', tTargets = t', tDeps = d'} =
      assert
         (t /= t' || (n == n' && d == d'))
         (t == t')

x !~= y = not (x =~= y)

type TaskGraph = Gr Task ()



-- |Removes dependencies which cannot be satisfied --- that is to say,
-- dependencies that do not exist and are not targeted. The second element of
-- the tuple returned contains the removed dependencies.
splitImpossibles :: [Task] -> CoData ([Task], [Task])
splitImpossibles ts = do
   let targets        = concatMap tTargets ts
       deps           = map (\t -> (t, tDeps t)) ts
       untargetedDeps = filter (any (`notElem` targets) . snd) deps

   impossibleDeps <- io$ filterM (fmap not.allPathsExist.snd) untargetedDeps

   let impossibleTasks = map fst impossibleDeps

   return (filter (\x -> all (!~= x) impossibleTasks) ts, impossibleTasks)

-- |Returns a (graph of tasks, cycles) pair. All cycles are removed from the
-- graph.
splitCycles :: [Task] -> (TaskGraph, [[Task]])
splitCycles tasks = (delNodes (concat cycleNodes) graph, cycles)
 where
   pairs      = toPairs tasks
   edges      = toEdges tasks pairs
   graph      = mkGraph (zip [0..] tasks) edges
   cycleNodes = filter (not.length1) . scc $ graph
   cycles     = (map.map) (fromJust . lab graph) cycleNodes

-- |For each Task, finds all those which target any of its dependencies.
toPairs :: [Task] -> [(Task, [Task])]
toPairs tasks = map (\t -> (t, findDependencies t)) tasks
   where
   findDependencies :: Task -> [Task]
   findDependencies task = filter (`targets` (tDeps task)) tasks

   targets :: Task -> [Source] -> Bool
   targets (Task {tTargets = ts}) = any (`elem` ts)

-- |fst of each resulting element is the index of the dependency in the pairs
-- |snd of each resulting element is the index of the target     in the pairs
toEdges :: [Task] -> [(Task, [Task])] -> [(Int, Int, ())]
toEdges tasks pairs =
   let toIndex t = fromJust $ findIndex (=~= t) tasks
    in concatMap
         (\(target, deps) ->
            let tarIdx = toIndex target
             in map (\dep -> (toIndex dep, tarIdx, ())) deps)
         pairs