-----------------------------------------------------------------------------
-- |
-- Module      :  Make.Rule
-- Copyright   :  (c) 2008, Andrea Vezzosi
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module defines the low-level representation of rules,
-- i.e. transformations from dependencies to targets.
module Make.Rule 
    (
     Rule(..)
    ,staticdeps
    ,complete
    ,addT
    ,shiftR
    ,(=:)
    ,module Make.App
    )            
where
import Data.List (nub,intersect)
import Make.App hiding (shiftR)
import qualified Make.App
import Control.Monad (liftM)


-- | A rule for building some targets from some dependencies using an action
-- in the monad @m@.
--
data Rule m target repr = Rule {

  -- | The static targets for this rule.
  targets :: [target],

  -- | The action in the monad for the rule. It returns the new
  -- representation value for each of the targets. So the return list
  -- must match up with the 'targets' list.  The dependencies are
  -- automatically tracked by the WApp monad, that produces the
  -- computation in the monad @m@ as result.
  action  :: WApp (Rule m) target repr (m [(target,repr)])

}

instance (Show t,Show r) => Show (Rule m t r) where
    show r = "Rule "++ show (staticdeps r) ++ " => " ++ show (targets r)

instance Ord t => Ord (Rule m t r) where
    compare r1 r2 = compare (targets r1) (targets r2)

instance Ord t => Eq (Rule m t r) where
    r == s = compare r s == EQ

staticdeps :: Rule m target repr -> [target]
staticdeps = map fst . collect . action

complete :: (Eq target) => [Rule m target repr] -> Bool
complete rs = nub (concatMap staticdeps rs) `subset` nub (concatMap targets rs)
    where 
      subset xs ys = intersect xs ys == xs

-- Utils

(=:) :: target -> repr -> (target, repr)
(=:) = (,)

addT :: (Monad m) => target -> WApp rule target repr (m repr) -> WApp rule target repr (m [(target, repr)])
addT t = fmap (liftM ((:[]) . (t =:)))

--shiftR :: Functor m => Rule m target repr -> Rule m (Either t target) (Either r repr)
shiftR :: (Functor m) =>
          (t -> t')
          -> (r -> r')
          -> (r' -> r)
          -> Rule m t r
          -> Rule m t' r'
shiftR inF inG fromG (Rule ts a) = 
    Rule { 
          targets = map inF ts
         ,action = fmap (fmap (fmap (\(t,r) -> (inF t,inG r)))) $ Make.App.shiftR inF fromG (shiftR inF inG fromG) a
         }