    {-# 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 = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> (SomeException -> IO a) -> SomeException -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO

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

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

    alternatives :: [(String, String)]
    alternatives = let * :: a -> b -> (a, b)
    (*) = (,) in
        [String
    "_rule_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "oracle"
        ,String
    "_Rule_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "Oracle"
        ,String
    "_key_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "question"
        ,String
    "_Key_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "Question"
        ,String
    "_result_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "answer"
        ,String
    "_Result_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "Answer"
        ,String
    "_addBuiltinRule_" String -> String -> (String, String)
    forall a b. a -> b -> (a, b)
    * String
    "addOracle"
        ,String
    "_apply_" String -> String -> (String, String)
    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 = ErrorCall -> SomeException
    forall e. Exception e => e -> SomeException
    toException (ErrorCall -> SomeException) -> ErrorCall -> SomeException
    forall a b. (a -> b) -> a -> b
    $ String -> ErrorCall
    ErrorCall (String -> ErrorCall) -> String -> ErrorCall
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
            [String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if [(String, Maybe String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(String, Maybe String)]
    args then String
    "." else String
    ":")] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
            [String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    ':' | String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    ""] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    as Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b | (String
    a,String
    b) <- [(String, String)]
    args2] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
            [String
    hint | String
    hint String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    ""]
        where
            as :: Int
    as = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    0 Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : ((String, String) -> Int) -> [(String, String)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> ((String, String) -> String) -> (String, String) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    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) (((String, Maybe String) -> (String, Maybe String))
    -> [(String, Maybe String)] -> [(String, Maybe String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> String)
    -> (String, Maybe String) -> (String, Maybe String)
    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 = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '_') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    alt then String -> String
    g else String -> String
    forall a. a -> a
    id)
            g :: String -> String
    g String
    xs | String
    res:[String]
    _ <- [String
    to String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    g String
    rest | (String
    from, String
    to) <- [(String, String)]
    alternatives, Just String
    rest <- [String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    from String
    xs]] = String
    res
            g (Char
    x:String
    xs) = Char
    x Char -> String -> String
    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", String -> Maybe String
    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", String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> String
    forall a. Show a => a -> String
    show TypeRep
    tk)
        ,(String
    "_Key_ value", Maybe String
    k)
        ,(String
    "_Result_ type", (TypeRep -> String) -> Maybe TypeRep -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypeRep -> String
    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", String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> String
    forall a. Show a => a -> String
    show TypeRep
    tk) (String, Maybe String)
    -> [(String, Maybe String)] -> [(String, Maybe String)]
    forall a. a -> [a] -> [a]
    :
         [(String
    "Location " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    i, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x) | (Integer
    i, String
    x) <- Integer -> [String] -> [(Integer, String)]
    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 " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if [Maybe String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Maybe String]
    names then String
    "no" else String
    "multiple") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " rules")
        ([(String
    "Key type",String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> String
    forall a. Show a => a -> String
    show TypeRep
    tk)
        ,(String
    "Key value",String -> Maybe String
    forall a. a -> Maybe a
    Just String
    k)
        ,(String
    "Rules matched",String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ [Maybe String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Maybe String]
    names)] [(String, Maybe String)]
    -> [(String, Maybe String)] -> [(String, Maybe String)]
    forall a. [a] -> [a] -> [a]
    ++
        [(String
    "Rule " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    i, Maybe String
    x) | (Maybe String -> Bool) -> [Maybe String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust [Maybe String]
    names, (Integer
    i, Maybe String
    x) <- Integer -> [Maybe String] -> [(Integer, Maybe String)]
    forall a b. Enum a => a -> [b] -> [(a, b)]
    zipFrom Integer
    1 [Maybe String]
    names])
        (if [Maybe String] -> Bool
    forall a. [a] -> Bool
    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",String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> String
    forall a. Show a => a -> String
    show TypeRep
    tk)
        ,(String
    "Key value",String -> Maybe String
    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 " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    i, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    k) | (Integer
    i, String
    k) <- Integer -> [String] -> [(Integer, String)]
    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", String -> Maybe String
    forall a. a -> Maybe a
    Just String
    msg)
        ,(String
    "Key type", String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> String
    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 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "OracleQ"
        where con :: String
    con = TyCon -> String
    forall a. Show a => a -> String
    show (TyCon -> String) -> TyCon -> String
    forall a b. (a -> b) -> a -> b
    $ (TyCon, [TypeRep]) -> TyCon
    forall a b. (a, b) -> a
    fst ((TyCon, [TypeRep]) -> TyCon) -> (TyCon, [TypeRep]) -> TyCon
    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
    shakeExceptionTarget :: ShakeException -> String
    shakeExceptionStack :: ShakeException -> [String]
    shakeExceptionInner :: ShakeException -> SomeException
    shakeExceptionTarget :: String
    shakeExceptionStack :: [String]
    shakeExceptionInner :: SomeException
    ..} = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
            String
    "Error when running Shake build system:" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :
            [String]
    shakeExceptionStack [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
            [SomeException -> String
    forall e. Exception e => e -> String
    displayException SomeException
    shakeExceptionInner]