Coadjute-0.0.1: Coadjute/Rule.hs

-- File created: 2008-01-12 16:06:32

-- |Holds the 'Rule' and 'Coadjute' types and relevant functions which act on
-- them. For user code, the important parts here are the 'rule' family of
-- functions and sourceToDatum.
module Coadjute.Rule(
   Rule(..),
   Coadjute, runCoadjute,
   getUserArgs,
   rule, ruleM,
   rule', ruleM',
   sourceToDatum, sourceToDatum',
   TaskDatum, SingleDatum, MultiDatum
) where

import Control.Arrow       (first)
import Control.Monad.State (StateT(..), modify, gets)
import Control.Monad.Trans (MonadIO, liftIO)
import qualified Data.Set as Set

import Coadjute.CoData
import Coadjute.Task (Task(..), Source, Target)

data Rule =
   Rule { rName  :: String
        , rTasks :: [Task]
        }

data RuleList = RL [Rule]

addRule :: Rule -> RuleList -> RuleList
addRule r (RL rs) = RL (r:rs)

-- |Coadjute is the main monad you'll be working in. You can use the 'rule'
-- family of functions to add rules whilst within this monad, and you can have
-- a look at what arguments were given to you with 'getUserArgs'.
--
-- For your convenience, a 'MonadIO' instance is provided.
newtype Coadjute a = Co { unCo :: StateT (RuleList, [String]) CoData a }

instance Monad Coadjute where
   return        = Co . return
   (Co rs) >>= f = Co (rs >>= unCo.f)

instance MonadIO Coadjute where liftIO = Co . liftIO

runCoadjute :: Coadjute a -> CoData ([Rule], a)
runCoadjute (Co st) = do
   ua <- asks coUserArgs
   (ret, (RL l, _)) <- runStateT st (RL [], ua)
   return (reverse l, ret)

-- | You should use this instead of 'System.Environment.getArgs', to let
-- Coadjute handle its own command line arguments first.
getUserArgs :: Coadjute [String]
getUserArgs = Co $ gets snd

newtype TaskDatum a = TD ([Source], a)

-- | A SingleDatum stores a single 'Target'.
type SingleDatum = TaskDatum  Target

-- | A MultiDatum stores multiple 'Target's, to be built all at once in one
-- action.
type  MultiDatum = TaskDatum [Target]

-- |A rule for building targets individually.
rule :: String
     -> [String]
     -> ([Source] -> Target -> IO ())
     -> [SingleDatum]
     -> Coadjute ()
rule name args action =
   Co . modify . first . addRule . Rule name .
      map (\(TD (d, t)) -> Task name (Set.fromList args) [t] d (action d t))

-- |A rule for building multiple targets at once.
ruleM :: String
      -> [String]
      -> ([Source] -> [Target] -> IO ())
      -> [MultiDatum]
      -> Coadjute ()
ruleM name args action =
   Co . modify . first . addRule . Rule name .
      map (\(TD (d, t)) -> Task name (Set.fromList args) t d (action d t))

-- | > rule' = flip rule []
rule' :: String
      -> ([Source] -> Target -> IO ())
      -> [SingleDatum]
      -> Coadjute ()
rule' = flip rule []

-- | > ruleM' = flip ruleM []
ruleM' :: String
       -> ([Source] -> [Target] -> IO ())
       -> [MultiDatum]
       -> Coadjute ()
ruleM' = flip ruleM []

-- |Use a supplied function of type @Source -> ([Source], Target)@ or @Source
-- -> ([Source], [Target])@ to turn a list of Sources to 'SingleDatum's or
-- 'MultiDatum's, for passing to one of the 'rule' functions.
--
-- The original Source is prepended to the list of dependencies in the Datum.
sourceToDatum :: (Source -> ([Source], a)) -> [Source] -> [TaskDatum a]
sourceToDatum f = map (\x -> TD $ first (x:) (f x))

-- |A convenience around 'sourceToDatum' for when you don't wish to provide
-- extra dependencies.
sourceToDatum' :: (Source -> a) -> [Source] -> [TaskDatum a]
sourceToDatum' f = sourceToDatum ((,) [] . f)