{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}

module Development.Shake.Oracle(
    addOracle, addOracles, askOracle
    ) where

import Control.DeepSeq
import Data.Binary
import Data.Hashable
import Data.List
import Data.Typeable

import Development.Shake.Core


newtype Question = Question [String]
    deriving (Typeable,Eq,Hashable,Binary,NFData)
newtype Answer = Answer [String]
    deriving (Show,Typeable,Eq,Hashable,Binary,NFData)

instance Show Question where
    show (Question xs) = "Oracle " ++ unwords xs

instance Rule Question Answer where
    validStored _ _ = return False


-- | Add extra information which your build should depend on. For example:
--
-- > addOracle ["ghc"] $ return ["7.2.1"]
-- > addOracle ["ghc-pkg","shake"] $ return ["1.0"]
--
--   If a rule depends on the GHC version, it can then use @'askOracle' [\"ghc\"]@, and
--   if the GHC version changes, the rule will rebuild. It is common for the value returned
--   by 'askOracle' to be ignored.
--
--   The Oracle maps questions of @[String]@ to answers of @[String]@. This type is a
--   compromise. Questions will often be the singleton list, but allowing a list of strings
--   allows hierarchical schemes such as @ghc-pkg shake@, @ghc-pkg base@ etc.
--   The answers are often singleton lists, but sometimes are used as sets - for example
--   the list of packages returned by @ghc-pkg@.
--
--   Actions passed to 'addOracle' will be run in every Shake execution they are required,
--   their value will not be kept between runs. To get a similar behaviour using files, see
--   'Development.Shake.alwaysRerun'.
addOracle :: [String] -> Action [String] -> Rules ()
addOracle question act = rule $ \(Question q) ->
    if q == question then Just $ fmap Answer act else Nothing


-- | Add a function to generate an oracle, matching a prefix.
--
-- > addOracles ["reverse"] $ \xs -> return $ reverse xs
addOracles :: [String] -> ([String] -> Action [String]) -> Rules ()
addOracles pre act = rule $ \(Question q) ->
    fmap (fmap Answer . act) $ stripPrefix pre q


-- | Get information previously added with 'addOracle'.
askOracle :: [String] -> Action [String]
askOracle question = do Answer answer <- apply1 $ Question question; return answer