    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.Haskell.Exts
    -- Copyright   :  (c) Niklas Broberg 2004-2009
    -- License     :  BSD-style (see the file LICENSE.txt)
    --
    -- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- An umbrella module for the various functionality
    -- of the package. Also provides some convenient
    -- functionality for dealing directly with source files.
    --
    -----------------------------------------------------------------------------
    module Language.Haskell.Exts (
        -- * Re-exported modules
          module Language.Haskell.Exts.Syntax
        , module Language.Haskell.Exts.Build
        , module Language.Haskell.Exts.Lexer
        , module Language.Haskell.Exts.Pretty
        , module Language.Haskell.Exts.Fixity
        , module Language.Haskell.Exts.ExactPrint
        , module Language.Haskell.Exts.SrcLoc
        , module Language.Haskell.Exts.Comments
        , module Language.Haskell.Exts.Extension
        , module Language.Haskell.Exts.Parser
        -- * Parsing of Haskell source files
        , parseFile
        , parseFileWithMode
        , parseFileWithExts
        , parseFileWithComments
        , parseFileWithCommentsAndPragmas
        , parseFileContents
        , parseFileContentsWithMode
        , parseFileContentsWithExts
        , parseFileContentsWithComments
        -- * Read extensions declared in LANGUAGE pragmas
        , readExtensions
        ) where

    import Language.Haskell.Exts.Build
    import Language.Haskell.Exts.Comments
    import Language.Haskell.Exts.Parser
    import Language.Haskell.Exts.Syntax
    import Language.Haskell.Exts.Lexer ( lexTokenStream, lexTokenStreamWithMode, Token(..) )
    import Language.Haskell.Exts.Pretty
    import Language.Haskell.Exts.Fixity
    import Language.Haskell.Exts.ExactPrint
    import Language.Haskell.Exts.SrcLoc
    import Language.Haskell.Exts.Extension

    import Data.List
    import Data.Maybe (fromMaybe)
    import Language.Preprocessor.Unlit
    import System.IO

    -- | Parse a source file on disk, using the default parse mode.
    parseFile :: FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFile :: FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFile FilePath
    fp = ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFileWithMode (ParseMode
    defaultParseMode { parseFilename = fp }) FilePath
    fp

    -- | Parse a source file on disk, with an extra set of extensions to know about
    --   on top of what the file itself declares.
    parseFileWithExts :: [Extension] -> FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFileWithExts :: [Extension] -> FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFileWithExts [Extension]
    exts FilePath
    fp =
        ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFileWithMode (ParseMode
    defaultParseMode {
                             extensions = exts,
                             parseFilename = fp }) FilePath
    fp

    -- | Parse a source file on disk, supplying a custom parse mode.
    parseFileWithMode :: ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFileWithMode :: ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo))
    parseFileWithMode ParseMode
    p FilePath
    fp = FilePath -> IO FilePath
    readUTF8File FilePath
    fp IO FilePath
    -> (FilePath -> IO (ParseResult (Module SrcSpanInfo)))
    -> IO (ParseResult (Module SrcSpanInfo))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ParseResult (Module SrcSpanInfo)
    -> IO (ParseResult (Module SrcSpanInfo))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParseResult (Module SrcSpanInfo)
     -> IO (ParseResult (Module SrcSpanInfo)))
    -> (FilePath -> ParseResult (Module SrcSpanInfo))
    -> FilePath
    -> IO (ParseResult (Module SrcSpanInfo))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseMode -> FilePath -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithMode ParseMode
    p

    parseFileWithComments :: ParseMode -> FilePath -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
    parseFileWithComments :: ParseMode
    -> FilePath -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
    parseFileWithComments ParseMode
    p FilePath
    fp = FilePath -> IO FilePath
    readUTF8File FilePath
    fp IO FilePath
    -> (FilePath -> IO (ParseResult (Module SrcSpanInfo, [Comment])))
    -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ParseResult (Module SrcSpanInfo, [Comment])
    -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParseResult (Module SrcSpanInfo, [Comment])
     -> IO (ParseResult (Module SrcSpanInfo, [Comment])))
    -> (FilePath -> ParseResult (Module SrcSpanInfo, [Comment]))
    -> FilePath
    -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseMode
    -> FilePath -> ParseResult (Module SrcSpanInfo, [Comment])
    parseFileContentsWithComments ParseMode
    p

    -- | Parse a source file on disk, supplying a custom parse mode, and retaining comments
    --  as well as unknown pragmas.
    parseFileWithCommentsAndPragmas
      :: ParseMode -> FilePath
      -> IO (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
    parseFileWithCommentsAndPragmas :: ParseMode
    -> FilePath
    -> IO
         (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
    parseFileWithCommentsAndPragmas ParseMode
    p FilePath
    fp =
        FilePath -> IO FilePath
    readUTF8File FilePath
    fp IO FilePath
    -> (FilePath
        -> IO
             (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])))
    -> IO
         (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    -> IO
         (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
     -> IO
          (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])))
    -> (FilePath
        -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
    -> FilePath
    -> IO
         (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseMode
    -> FilePath
    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    parseFileContentsWithCommentsAndPragmas ParseMode
    p

    -- | Parse a source file from a string using a custom parse mode retaining comments
    --   as well as unknown pragmas.
    parseFileContentsWithCommentsAndPragmas
      :: ParseMode -> String
      -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    parseFileContentsWithCommentsAndPragmas :: ParseMode
    -> FilePath
    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    parseFileContentsWithCommentsAndPragmas ParseMode
    pmode FilePath
    str = ParseResult (Module SrcSpanInfo, [Comment])
    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    separatePragmas ParseResult (Module SrcSpanInfo, [Comment])
    parseResult
        where parseResult :: ParseResult (Module SrcSpanInfo, [Comment])
    parseResult = ParseMode
    -> FilePath -> ParseResult (Module SrcSpanInfo, [Comment])
    parseFileContentsWithComments ParseMode
    pmode FilePath
    str

    -- | Parse a source file from a string using the default parse mode.
    parseFileContents :: String -> ParseResult (Module SrcSpanInfo)
    parseFileContents :: FilePath -> ParseResult (Module SrcSpanInfo)
    parseFileContents = ParseMode -> FilePath -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithMode ParseMode
    defaultParseMode

    -- | Parse a source file from a string, with an extra set of extensions to know about
    --   on top of what the file itself declares.
    parseFileContentsWithExts :: [Extension] -> String -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithExts :: [Extension] -> FilePath -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithExts [Extension]
    exts =
        ParseMode -> FilePath -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithMode (ParseMode
    defaultParseMode { extensions = exts })

    -- | Parse a source file from a string using a custom parse mode.
    parseFileContentsWithMode :: ParseMode -> String -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithMode :: ParseMode -> FilePath -> ParseResult (Module SrcSpanInfo)
    parseFileContentsWithMode p :: ParseMode
    p@(ParseMode FilePath
    fn Language
    oldLang [Extension]
    exts Bool
    ign Bool
    _ Maybe [Fixity]
    _ Bool
    _) FilePath
    rawStr =
            let md :: FilePath
    md = FilePath -> FilePath -> FilePath
    delit FilePath
    fn (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    ppContents FilePath
    rawStr
                (Language
    bLang, [Extension]
    extraExts) =
                    case (Bool
    ign, FilePath -> Maybe (Maybe Language, [Extension])
    readExtensions FilePath
    md) of
                      (Bool
    False, Just (Maybe Language
    mLang, [Extension]
    es)) ->
                           (Language -> Maybe Language -> Language
    forall a. a -> Maybe a -> a
    fromMaybe Language
    oldLang Maybe Language
    mLang, [Extension]
    es)
                      (Bool, Maybe (Maybe Language, [Extension]))
    _ -> (Language
    oldLang, [])
             in -- trace (fn ++ ": " ++ show extraExts) $
                  ParseMode -> FilePath -> ParseResult (Module SrcSpanInfo)
    parseModuleWithMode (ParseMode
    p { baseLanguage = bLang, extensions = exts ++ extraExts }) FilePath
    md

    parseFileContentsWithComments :: ParseMode -> String -> ParseResult (Module SrcSpanInfo, [Comment])
    parseFileContentsWithComments :: ParseMode
    -> FilePath -> ParseResult (Module SrcSpanInfo, [Comment])
    parseFileContentsWithComments p :: ParseMode
    p@(ParseMode FilePath
    fn Language
    oldLang [Extension]
    exts Bool
    ign Bool
    _ Maybe [Fixity]
    _ Bool
    _) FilePath
    rawStr =
            let md :: FilePath
    md = FilePath -> FilePath -> FilePath
    delit FilePath
    fn (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    ppContents FilePath
    rawStr
                (Language
    bLang, [Extension]
    extraExts) =
                    case (Bool
    ign, FilePath -> Maybe (Maybe Language, [Extension])
    readExtensions FilePath
    md) of
                      (Bool
    False, Just (Maybe Language
    mLang, [Extension]
    es)) ->
                           (Language -> Maybe Language -> Language
    forall a. a -> Maybe a -> a
    fromMaybe Language
    oldLang Maybe Language
    mLang, [Extension]
    es)
                      (Bool, Maybe (Maybe Language, [Extension]))
    _ -> (Language
    oldLang, [])
             in ParseMode
    -> FilePath -> ParseResult (Module SrcSpanInfo, [Comment])
    parseModuleWithComments (ParseMode
    p { baseLanguage = bLang, extensions = exts ++ extraExts }) FilePath
    md

    -- | Gather the extensions declared in LANGUAGE pragmas
    --   at the top of the file. Returns 'Nothing' if the
    --   parse of the pragmas fails.
    readExtensions :: String -> Maybe (Maybe Language, [Extension])
    readExtensions :: FilePath -> Maybe (Maybe Language, [Extension])
    readExtensions FilePath
    str = case FilePath -> ParseResult [ModulePragma SrcSpanInfo]
    getTopPragmas FilePath
    str of
            ParseOk [ModulePragma SrcSpanInfo]
    pgms -> [Either Language Extension] -> Maybe (Maybe Language, [Extension])
    forall {a}. [Either Language a] -> Maybe (Maybe Language, [a])
    extractLang ([Either Language Extension]
     -> Maybe (Maybe Language, [Extension]))
    -> [Either Language Extension]
    -> Maybe (Maybe Language, [Extension])
    forall a b. (a -> b) -> a -> b
    $ (ModulePragma SrcSpanInfo -> [Either Language Extension])
    -> [ModulePragma SrcSpanInfo] -> [Either Language Extension]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ModulePragma SrcSpanInfo -> [Either Language Extension]
    forall l. ModulePragma l -> [Either Language Extension]
    getExts [ModulePragma SrcSpanInfo]
    pgms
            ParseResult [ModulePragma SrcSpanInfo]
    _            -> Maybe (Maybe Language, [Extension])
    forall a. Maybe a
    Nothing
      where getExts :: ModulePragma l -> [Either Language Extension]
            getExts :: forall l. ModulePragma l -> [Either Language Extension]
    getExts (LanguagePragma l
    _ [Name l]
    ns) = (Name l -> Either Language Extension)
    -> [Name l] -> [Either Language Extension]
    forall a b. (a -> b) -> [a] -> [b]
    map Name l -> Either Language Extension
    forall {l}. Name l -> Either Language Extension
    readExt [Name l]
    ns
            getExts ModulePragma l
    _ = []

            readExt :: Name l -> Either Language Extension
    readExt (Ident l
    _ FilePath
    e) =
                case FilePath -> Language
    classifyLanguage FilePath
    e of
                  UnknownLanguage FilePath
    _ -> Extension -> Either Language Extension
    forall a b. b -> Either a b
    Right (Extension -> Either Language Extension)
    -> Extension -> Either Language Extension
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Extension
    classifyExtension FilePath
    e
                  Language
    lang -> Language -> Either Language Extension
    forall a b. a -> Either a b
    Left Language
    lang
            readExt Symbol {} = FilePath -> Either Language Extension
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "readExt: Symbol"

            extractLang :: [Either Language a] -> Maybe (Maybe Language, [a])
    extractLang = Maybe Language
    -> [a] -> [Either Language a] -> Maybe (Maybe Language, [a])
    forall {a} {a}.
    Eq a =>
    Maybe a -> [a] -> [Either a a] -> Maybe (Maybe a, [a])
    extractLang' Maybe Language
    forall a. Maybe a
    Nothing []

            extractLang' :: Maybe a -> [a] -> [Either a a] -> Maybe (Maybe a, [a])
    extractLang' Maybe a
    lacc [a]
    eacc [] = (Maybe a, [a]) -> Maybe (Maybe a, [a])
    forall a. a -> Maybe a
    Just (Maybe a
    lacc, [a]
    eacc)
            extractLang' Maybe a
    Nothing [a]
    eacc (Left a
    l : [Either a a]
    rest) = Maybe a -> [a] -> [Either a a] -> Maybe (Maybe a, [a])
    extractLang' (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    l) [a]
    eacc [Either a a]
    rest
            extractLang' (Just a
    l1) [a]
    eacc (Left a
    l2:[Either a a]
    rest)
                | a
    l1 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    l2  = Maybe a -> [a] -> [Either a a] -> Maybe (Maybe a, [a])
    extractLang' (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    l1) [a]
    eacc [Either a a]
    rest
                | Bool
    otherwise = Maybe (Maybe a, [a])
    forall a. Maybe a
    Nothing
            extractLang' Maybe a
    lacc [a]
    eacc (Right a
    ext : [Either a a]
    rest) = Maybe a -> [a] -> [Either a a] -> Maybe (Maybe a, [a])
    extractLang' Maybe a
    lacc (a
    exta -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    eacc) [Either a a]
    rest

    ppContents :: String -> String
    ppContents :: FilePath -> FilePath
    ppContents = [FilePath] -> FilePath
    unlines ([FilePath] -> FilePath)
    -> (FilePath -> [FilePath]) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [FilePath] -> [FilePath]
    f ([FilePath] -> [FilePath])
    -> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> [FilePath]
    lines
      where f :: [FilePath] -> [FilePath]
    f ((Char
    '#':FilePath
    _):[FilePath]
    rest) = [FilePath]
    rest
            f [FilePath]
    x = [FilePath]
    x

    delit :: String -> String -> String
    delit :: FilePath -> FilePath -> FilePath
    delit FilePath
    fn = if FilePath
    ".lhs" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` FilePath
    fn then FilePath -> FilePath -> FilePath
    unlit FilePath
    fn else FilePath -> FilePath
    forall a. a -> a
    id

    readUTF8File :: FilePath -> IO String
    readUTF8File :: FilePath -> IO FilePath
    readUTF8File FilePath
    fp = do
      h <- FilePath -> IOMode -> IO Handle
    openFile FilePath
    fp IOMode
    ReadMode
      hSetEncoding h utf8
      hGetContents h

    -- | Converts a parse result with comments to a parse result with comments and
    --   unknown pragmas.
    separatePragmas :: ParseResult (Module SrcSpanInfo, [Comment])
                    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    separatePragmas :: ParseResult (Module SrcSpanInfo, [Comment])
    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    separatePragmas ParseResult (Module SrcSpanInfo, [Comment])
    r =
        case ParseResult (Module SrcSpanInfo, [Comment])
    r of
            ParseOk (Module SrcSpanInfo
    m, [Comment]
    comments) ->
                let ([Comment]
    pragmas, [Comment]
    comments') = (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Comment -> Bool
    pragLike [Comment]
    comments
                  in  (Module SrcSpanInfo, [Comment], [UnknownPragma])
    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    forall a. a -> ParseResult a
    ParseOk (Module SrcSpanInfo
    m, [Comment]
    comments', (Comment -> UnknownPragma) -> [Comment] -> [UnknownPragma]
    forall a b. (a -> b) -> [a] -> [b]
    map Comment -> UnknownPragma
    commentToPragma [Comment]
    pragmas)
                    where commentToPragma :: Comment -> UnknownPragma
    commentToPragma (Comment Bool
    _ SrcSpan
    l FilePath
    s) =
                                SrcSpan -> FilePath -> UnknownPragma
    UnknownPragma SrcSpan
    l (FilePath -> UnknownPragma) -> FilePath -> UnknownPragma
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    forall a. HasCallStack => [a] -> [a]
    init (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    drop Int
    1 FilePath
    s
                          pragLike :: Comment -> Bool
    pragLike (Comment Bool
    b SrcSpan
    _ FilePath
    s) = Bool
    b Bool -> Bool -> Bool
    && FilePath -> Bool
    pcond FilePath
    s
                          pcond :: FilePath -> Bool
    pcond FilePath
    s = FilePath -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 Bool -> Bool -> Bool
    && Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    take Int
    1 FilePath
    s FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "#" Bool -> Bool -> Bool
    && FilePath -> Char
    forall a. HasCallStack => [a] -> a
    last FilePath
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '#'
            ParseFailed SrcLoc
    l FilePath
    s ->  SrcLoc
    -> FilePath
    -> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
    forall a. SrcLoc -> FilePath -> ParseResult a
    ParseFailed SrcLoc
    l FilePath
    s