    {-# LANGUAGE ImportQualifiedPost #-}
    {-# LANGUAGE PatternGuards, ViewPatterns, TupleSections #-}
    module Config.Haskell(
        readPragma,
        readComment
        ) where

    import Data.Char
    import Data.List.Extra
    import Text.Read
    import Data.Tuple.Extra
    import Data.Maybe
    import Config.Type
    import Util
    import Prelude

    import GHC.Util

    import GHC.Types.SrcLoc
    import GHC.Hs.Extension
    import GHC.Hs.Decls hiding (SpliceDecl)
    import GHC.Hs.Expr hiding (Match)
    import GHC.Hs.Lit
    import GHC.Data.FastString
    import GHC.Parser.Annotation
    import GHC.Utils.Outputable
    import GHC.Data.Strict qualified

    import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
    import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader

    -- | Read an {-# ANN #-} pragma and determine if it is intended for HLint.
    --   Return Nothing if it is not an HLint pragma, otherwise what it means.
    readPragma :: AnnDecl GhcPs -> Maybe Classify
    readPragma :: AnnDecl GhcPs -> Maybe Classify
    readPragma (HsAnnotation XHsAnnotation GhcPs
    _ AnnProvenance GhcPs
    provenance XRec GhcPs (HsExpr GhcPs)
    expr) = LocatedA (HsExpr GhcPs) -> Maybe Classify
    f XRec GhcPs (HsExpr GhcPs)
    LocatedA (HsExpr GhcPs)
    expr
        where
            name :: String
    name = case AnnProvenance GhcPs
    provenance of
                ValueAnnProvenance (L SrcSpanAnnN
    _ RdrName
    x) -> RdrName -> String
    occNameStr RdrName
    x
                TypeAnnProvenance (L SrcSpanAnnN
    _ RdrName
    x) -> RdrName -> String
    occNameStr RdrName
    x
                AnnProvenance GhcPs
    ModuleAnnProvenance -> String
    ""

            f :: LocatedA (HsExpr GhcPs) -> Maybe Classify
            f :: LocatedA (HsExpr GhcPs) -> Maybe Classify
    f (L SrcSpanAnnA
    _ (HsLit XLitE GhcPs
    _ (HsString XHsString GhcPs
    _ (FastString -> String
    unpackFS -> String
    s)))) | String
    "hlint:" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String -> String
    lower String
    s =
                    case String -> Maybe Severity
    getSeverity String
    a of
                        Maybe Severity
    Nothing -> LocatedA (HsExpr GhcPs) -> String -> Maybe Classify
    forall a b. Outputable a => LocatedA a -> String -> b
    errorOn XRec GhcPs (HsExpr GhcPs)
    LocatedA (HsExpr GhcPs)
    expr String
    "bad classify pragma"
                        Just Severity
    severity -> Classify -> Maybe Classify
    forall a. a -> Maybe a
    Just (Classify -> Maybe Classify) -> Classify -> Maybe Classify
    forall a b. (a -> b) -> a -> b
    $ Severity -> String -> String -> String -> Classify
    Classify Severity
    severity (String -> String
    trimStart String
    b) String
    "" String
    name
                where (String
    a,String
    b) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    trimStart (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    6 String
    s
            f (L SrcSpanAnnA
    _ (HsPar XPar GhcPs
    _ XRec GhcPs (HsExpr GhcPs)
    x)) = LocatedA (HsExpr GhcPs) -> Maybe Classify
    f XRec GhcPs (HsExpr GhcPs)
    LocatedA (HsExpr GhcPs)
    x
            f (L SrcSpanAnnA
    _ (ExprWithTySig XExprWithTySig GhcPs
    _ XRec GhcPs (HsExpr GhcPs)
    x LHsSigWcType (NoGhcTc GhcPs)
    _)) = LocatedA (HsExpr GhcPs) -> Maybe Classify
    f XRec GhcPs (HsExpr GhcPs)
    LocatedA (HsExpr GhcPs)
    x
            f LocatedA (HsExpr GhcPs)
    _ = Maybe Classify
    forall a. Maybe a
    Nothing

    readComment :: LEpaComment -> [Classify]
    readComment :: LEpaComment -> [Classify]
    readComment c :: LEpaComment
    c@(L NoCommentsLocation
    pos (EpaComment EpaBlockComment{} RealSrcSpan
    _))
        | (Bool
    hash, String
    x) <- (Bool, String)
    -> (String -> (Bool, String)) -> Maybe String -> (Bool, String)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool
    False, String
    x) (Bool
    True,) (Maybe String -> (Bool, String)) -> Maybe String -> (Bool, String)
    forall a b. (a -> b) -> a -> b
    $ String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    "#" String
    x
        , String
    x <- String -> String
    trim String
    x
        , (String
    hlint, String
    x) <- String -> (String, String)
    word1 String
    x
        , String -> String
    lower String
    hlint String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "hlint"
        = Bool -> String -> [Classify]
    f Bool
    hash String
    x
        where
            x :: String
    x = LEpaComment -> String
    commentText LEpaComment
    c
            f :: Bool -> String -> [Classify]
    f Bool
    hash String
    x
                | Just String
    x <- if Bool
    hash then String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix String
    "#" String
    x else String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x
                , (String
    sev, String
    x) <- String -> (String, String)
    word1 String
    x
                , Just Severity
    sev <- String -> Maybe Severity
    getSeverity String
    sev
                , ([String]
    things, String
    x) <- String -> ([String], String)
    g String
    x
                , Just String
    hint <- if String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" then String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "" else String -> Maybe String
    forall a. Read a => String -> Maybe a
    readMaybe String
    x
                = (String -> Classify) -> [String] -> [Classify]
    forall a b. (a -> b) -> [a] -> [b]
    map (Severity -> String -> String -> String -> Classify
    Classify Severity
    sev String
    hint String
    "") ([String] -> [Classify]) -> [String] -> [Classify]
    forall a b. (a -> b) -> a -> b
    $ [String
    "" | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    things] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    things
            f Bool
    hash String
    _ = LEpaComment -> String -> [Classify]
    forall b. LEpaComment -> String -> b
    errorOnComment LEpaComment
    c (String -> [Classify]) -> String -> [Classify]
    forall a b. (a -> b) -> a -> b
    $ String
    "bad HLINT pragma, expected:\n    {-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    h String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " HLINT <severity> <identifier> \"Hint name\" " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    h String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-}"
                where h :: String
    h = [Char
    '#' | Bool
    hash]

            g :: String -> ([String], String)
    g String
    x | (String
    s, String
    x) <- String -> (String, String)
    word1 String
    x
                , String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    ""
                , Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "\"" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s
                = ([String] -> [String]) -> ([String], String) -> ([String], String)
    forall a a' b. (a -> a') -> (a, b) -> (a', b)
    first ((if String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "module" then String
    "" else String
    s)String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :) (([String], String) -> ([String], String))
    -> ([String], String) -> ([String], String)
    forall a b. (a -> b) -> a -> b
    $ String -> ([String], String)
    g String
    x
            g String
    x = ([], String
    x)
    readComment LEpaComment
    _ = []

    errorOn :: Outputable a => LocatedA a -> String -> b
    errorOn :: forall a b. Outputable a => LocatedA a -> String -> b
    errorOn (L SrcSpanAnnA
    pos a
    val) String
    msg = String -> b
    forall a. String -> a
    exitMessageImpure (String -> b) -> String -> b
    forall a b. (a -> b) -> a -> b
    $
        SrcSpan -> String
    showSrcSpan (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    pos) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        String
    ": Error while reading hint file, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        a -> String
    forall a. Outputable a => a -> String
    unsafePrettyPrint a
    val

    errorOnComment :: LEpaComment -> String -> b
    errorOnComment :: forall b. LEpaComment -> String -> b
    errorOnComment c :: LEpaComment
    c@(L NoCommentsLocation
    s EpaComment
    _) String
    msg = String -> b
    forall a. String -> a
    exitMessageImpure (String -> b) -> String -> b
    forall a b. (a -> b) -> a -> b
    $
        let isMultiline :: Bool
    isMultiline = LEpaComment -> Bool
    isCommentMultiline LEpaComment
    c in
        SrcSpan -> String
    showSrcSpan (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (NoCommentsLocation -> RealSrcSpan
    forall a. EpaLocation' a -> RealSrcSpan
    epaLocationRealSrcSpan NoCommentsLocation
    s) Maybe BufSpan
    forall a. Maybe a
    GHC.Data.Strict.Nothing) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        String
    ": Error while reading hint file, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        (if Bool
    isMultiline then String
    "{-" else String
    "--") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ LEpaComment -> String
    commentText LEpaComment
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if Bool
    isMultiline then String
    "-}" else String
    "")