{-# LANGUAGE FlexibleInstances #-}

-- | A module for data types that have an output file(s) target and/or can reference a target. e.g. The @Javac@ data type might have an output target given by the @-d@ option and references a target by the @-classpath@ option.
module Lastik.Output(
                     Output(..),
                     OutputReference(..),
                     (<=+=>),
                     (<=++=>),
                     (>===>),
                     (>=>=>),
                     outref,
                     (<==>),
                     (<===>)
                    ) where

import Control.Monad
import Control.Monad.Instances
import Data.Maybe
import System.Directory
import System.FilePath.Find

-- | A class of data types that have a potential output target.
class Output o where
  output :: o -> Maybe FilePath

instance Output (Maybe FilePath) where
  output = id

instance Output [FilePath] where
  output = listToMaybe

-- | A class of data types that can reference an output target.
class OutputReference r where
  reference :: [FilePath] -> r -> r
  reference' :: r -> [FilePath]

-- | Adds the given file path to the reference target of the given value.
(<=+=>) :: (OutputReference r) =>
           FilePath -- ^ The file path to add.
           -> r     -- ^ The value to add the given file path to.
           -> r     -- ^ The value with the given file path added.
v <=+=> k = reference (v : reference' k) k

-- | Adds the given file paths to the reference target of the given value.
(<=++=>) :: (OutputReference r) =>
            [FilePath] -- ^ The file paths to add.
            -> r       -- ^ The value to add the given file paths to.
            -> r       -- ^ The value with the given file paths added.
v <=++=> k = reference (v ++ reference' k) k

-- | Adds the (potential) output target of the given value to the output target of the given value.
(>===>) :: (Output o, OutputReference r) =>
           o    -- ^ The value with an output target value to add.
           -> r -- ^ The value to add the output target to.
           -> r -- ^ The value after the output target has been added.
v >===> w = case output v of Nothing -> w
                             Just y -> y <=+=> w

-- | Adds the (potential) output target and output references of the given value to the output target of the given value.
(>=>=>) :: (Output o, OutputReference o, OutputReference r) =>
           o    -- ^ The value with an output target and output references to add.
           -> r -- ^ The value to add the output target and output references to.
           -> r -- ^ The value after the output target has been added.
v >=>=> w = v >===> (reference' v <=++=> w)

-- | Adds the output target to the output reference of the given value.
outref :: (Output o, OutputReference o) =>
          o    -- ^ The value to add the output target to its output reference.
          -> o
outref = join (>===>)

-- | Returns all existing files of the second argument that have a later last-modification time than the latest of all existing files in the first argument.
(<==>) :: [FilePath]       -- ^ The set of file paths to compute the latest modification time.
          -> [FilePath]    -- ^ The set of file paths to filter and keep those that have a later modification time.
          -> IO [FilePath] -- ^ The file paths with a later last-modification time than the latest in the first argument.
d <==> s = do e <- filterM (\k -> liftM2 (||) (doesFileExist k) (doesDirectoryExist k)) d
              if null e
                then return s
                else do filterM (\z -> liftM2 (>) (getModificationTime z) (fmap maximum $ mapM getModificationTime e)) s

-- | Returns all existing files of the second argument that have a later last-modification time than all files (recursively) in the output target of the the first argument.
(<===>) :: (Output o) =>
           o                -- ^ The value to compute the output target and recursively search for the latest last-modification time.
           -> [FilePath]    -- ^ The set of file paths to filter and keep those that have a later modification time.
           -> IO [FilePath] -- ^ The file paths with a later last-modification time than the latest in the output target of the first argument.
d <===> s = case output d of Nothing -> return s
                             Just k -> do e <- doesDirectoryExist k
                                          if e
                                            then find always always k >>= (\t -> t <==> s)
                                            else return s