{-# LANGUAGE DeriveDataTypeable, PatternGuards, RecordWildCards, ConstraintKinds #-}

-- | Errors seen by the user
module Development.Shake.Internal.Errors(
    ShakeException(..),
    throwM, throwImpure,
    errorInternal,
    errorStructured,
    errorNoRuleToBuildType, errorRuleDefinedMultipleTimes,
    errorMultipleRulesMatch, errorRuleRecursion, errorComplexRecursion, errorNoApply,
    errorDirectoryNotFile, errorNoHash
    ) where

import Data.Tuple.Extra
import Control.Exception.Extra
import Control.Monad.IO.Class
import General.Extra
import Data.Typeable
import Data.List.Extra
import Data.Maybe


throwM :: MonadIO m => SomeException -> m a
throwM :: forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO

throwImpure :: SomeException -> a
throwImpure :: forall a. SomeException -> a
throwImpure = forall a e. Exception e => e -> a
throw


errorInternal :: Partial => String -> SomeException
errorInternal :: Partial => String -> SomeException
errorInternal String
msg = forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
    (String
"Development.Shake: Internal error, please report to Neil Mitchell (" forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
")") forall a. a -> [a] -> [a]
: Partial => [String]
callStackFull

alternatives :: [(String, String)]
alternatives = let * :: a -> b -> (a, b)
(*) = (,) in
    [String
"_rule_" forall a b. a -> b -> (a, b)
* String
"oracle"
    ,String
"_Rule_" forall a b. a -> b -> (a, b)
* String
"Oracle"
    ,String
"_key_" forall a b. a -> b -> (a, b)
* String
"question"
    ,String
"_Key_" forall a b. a -> b -> (a, b)
* String
"Question"
    ,String
"_result_" forall a b. a -> b -> (a, b)
* String
"answer"
    ,String
"_Result_" forall a b. a -> b -> (a, b)
* String
"Answer"
    ,String
"_addBuiltinRule_" forall a b. a -> b -> (a, b)
* String
"addOracle"
    ,String
"_apply_" forall a b. a -> b -> (a, b)
* String
"askOracle"]


errorStructured :: String -> [(String, Maybe String)] -> String -> SomeException
errorStructured :: String -> [(String, Maybe String)] -> String -> SomeException
errorStructured String
msg [(String, Maybe String)]
args String
hint = forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
        [String
msg forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Maybe String)]
args then String
"." else String
":")] forall a. [a] -> [a] -> [a]
++
        [String
"  " forall a. [a] -> [a] -> [a]
++ String
a forall a. [a] -> [a] -> [a]
++ [Char
':' | String
a forall a. Eq a => a -> a -> Bool
/= String
""] forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
as forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a forall a. Num a => a -> a -> a
+ Int
2) Char
' ' forall a. [a] -> [a] -> [a]
++ String
b | (String
a,String
b) <- [(String, String)]
args2] forall a. [a] -> [a] -> [a]
++
        [String
hint | String
hint forall a. Eq a => a -> a -> Bool
/= String
""]
    where
        as :: Int
as = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ Int
0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
args2
        args2 :: [(String, String)]
args2 = [(String
a,String
b) | (String
a,Just String
b) <- [(String, Maybe String)]
args]



structured :: Bool -> String -> [(String, Maybe String)] -> String -> SomeException
structured :: Bool
-> String -> [(String, Maybe String)] -> String -> SomeException
structured Bool
alt String
msg [(String, Maybe String)]
args String
hint = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured (String -> String
f String
msg) (forall a b. (a -> b) -> [a] -> [b]
map (forall a a' b. (a -> a') -> (a, b) -> (a', b)
first String -> String
f) [(String, Maybe String)]
args) (String -> String
f String
hint)
    where
        f :: String -> String
f = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'_') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
alt then String -> String
g else forall a. a -> a
id)
        g :: String -> String
g String
xs | String
res:[String]
_ <- [String
to forall a. [a] -> [a] -> [a]
++ String -> String
g String
rest | (String
from, String
to) <- [(String, String)]
alternatives, Just String
rest <- [forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
from String
xs]] = String
res
        g (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: String -> String
g String
xs
        g [] = []


errorDirectoryNotFile :: FilePath -> SomeException
errorDirectoryNotFile :: String -> SomeException
errorDirectoryNotFile String
dir = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
    String
"Build system error - expected a file, got a directory"
    [(String
"Directory", forall a. a -> Maybe a
Just String
dir)]
    String
"Probably due to calling 'need' on a directory. Shake only permits 'need' on files."

errorNoRuleToBuildType :: TypeRep -> Maybe String -> Maybe TypeRep -> SomeException
errorNoRuleToBuildType :: TypeRep -> Maybe String -> Maybe TypeRep -> SomeException
errorNoRuleToBuildType TypeRep
tk Maybe String
k Maybe TypeRep
tv = Bool
-> String -> [(String, Maybe String)] -> String -> SomeException
structured (TypeRep -> Bool
specialIsOracleKey TypeRep
tk)
    String
"Build system error - no _rule_ matches the _key_ type"
    [(String
"_Key_ type", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeRep
tk)
    ,(String
"_Key_ value", Maybe String
k)
    ,(String
"_Result_ type", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show Maybe TypeRep
tv)]
    String
"You are missing a call to _addBuiltinRule_, or your call to _apply_ has the wrong _key_ type"

errorRuleDefinedMultipleTimes :: TypeRep -> [String] -> SomeException
errorRuleDefinedMultipleTimes :: TypeRep -> [String] -> SomeException
errorRuleDefinedMultipleTimes TypeRep
tk [String]
locations = Bool
-> String -> [(String, Maybe String)] -> String -> SomeException
structured (TypeRep -> Bool
specialIsOracleKey TypeRep
tk)
    String
"Build system error - _rule_ defined twice at one _key_ type"
    ((String
"_Key_ type", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeRep
tk) forall a. a -> [a] -> [a]
:
     [(String
"Location " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i, forall a. a -> Maybe a
Just String
x) | (Integer
i, String
x) <- forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Integer
1 [String]
locations])
    String
"You have called _addBuiltinRule_ more than once on the same key type"

errorMultipleRulesMatch :: TypeRep -> String -> [Maybe String] -> SomeException
errorMultipleRulesMatch :: TypeRep -> String -> [Maybe String] -> SomeException
errorMultipleRulesMatch TypeRep
tk String
k [Maybe String]
names = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
    (String
"Build system error - key matches " forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe String]
names then String
"no" else String
"multiple") forall a. [a] -> [a] -> [a]
++ String
" rules")
    ([(String
"Key type",forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeRep
tk)
    ,(String
"Key value",forall a. a -> Maybe a
Just String
k)
    ,(String
"Rules matched",forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe String]
names)] forall a. [a] -> [a] -> [a]
++
    [(String
"Rule " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i, Maybe String
x) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust [Maybe String]
names, (Integer
i, Maybe String
x) <- forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Integer
1 [Maybe String]
names])
    (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe String]
names then String
"Either add a rule that produces the above key, or stop requiring the above key"
    else String
"Modify your rules so only one can produce the above key")

errorNoHash :: SomeException
errorNoHash :: SomeException
errorNoHash = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured String
"Cannot use shakeChange=ChangeModTime with shakeShare" [] String
""

errorRuleRecursion :: TypeRep -> String -> SomeException
-- may involve both rules and oracle, so report as only rules
errorRuleRecursion :: TypeRep -> String -> SomeException
errorRuleRecursion TypeRep
tk String
k = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
    String
"Build system error - recursion detected"
    [(String
"Key type",forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeRep
tk)
    ,(String
"Key value",forall a. a -> Maybe a
Just String
k)]
    String
"Rules may not be recursive"

errorComplexRecursion :: [String] -> SomeException
errorComplexRecursion :: [String] -> SomeException
errorComplexRecursion [String]
ks = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
    String
"Build system error - indirect recursion detected"
    [(String
"Key value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i, forall a. a -> Maybe a
Just String
k) | (Integer
i, String
k) <- forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Integer
1 [String]
ks]
    String
"Rules may not be recursive"

errorNoApply :: TypeRep -> Maybe String -> String -> SomeException
errorNoApply :: TypeRep -> Maybe String -> String -> SomeException
errorNoApply TypeRep
tk Maybe String
k String
msg = String -> [(String, Maybe String)] -> String -> SomeException
errorStructured
    String
"Build system error - cannot currently introduce a dependency (e.g. calling 'apply')"
    [(String
"Reason", forall a. a -> Maybe a
Just String
msg)
    ,(String
"Key type", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TypeRep
tk)
    ,(String
"Key value", Maybe String
k)]
    String
"Move the call earlier/later"


-- Should be in Special, but then we get an import cycle
specialIsOracleKey :: TypeRep -> Bool
specialIsOracleKey :: TypeRep -> Bool
specialIsOracleKey TypeRep
t = String
con forall a. Eq a => a -> a -> Bool
== String
"OracleQ"
    where con :: String
con = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
t


-- | Error representing all expected exceptions thrown by Shake.
--   Problems when executing rules will be raising using this exception type.
data ShakeException = ShakeException
    {ShakeException -> String
shakeExceptionTarget :: String -- ^ The target that was being built when the exception occurred.
    ,ShakeException -> [String]
shakeExceptionStack :: [String]  -- ^ A description of the call stack, one entry per line.
    ,ShakeException -> SomeException
shakeExceptionInner :: SomeException -- ^ The underlying exception that was raised.
    }
    deriving Typeable

instance Exception ShakeException

instance Show ShakeException where
    show :: ShakeException -> String
show ShakeException{String
[String]
SomeException
shakeExceptionInner :: SomeException
shakeExceptionStack :: [String]
shakeExceptionTarget :: String
shakeExceptionInner :: ShakeException -> SomeException
shakeExceptionStack :: ShakeException -> [String]
shakeExceptionTarget :: ShakeException -> String
..} = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
        String
"Error when running Shake build system:" forall a. a -> [a] -> [a]
:
        [String]
shakeExceptionStack forall a. [a] -> [a] -> [a]
++
        [forall e. Exception e => e -> String
displayException SomeException
shakeExceptionInner]