-----------------------------------------------------------------------------
-- |
-- 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 :: FilePath
parseFilename = FilePath
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 :: [Extension]
extensions = [Extension]
exts,
                         parseFilename :: FilePath
parseFilename = FilePath
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParseResult (Module SrcSpanInfo)
-> IO (ParseResult (Module SrcSpanInfo))
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParseResult (Module SrcSpanInfo, [Comment])
-> IO (ParseResult (Module SrcSpanInfo, [Comment]))
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
-> IO
     (ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma]))
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 :: [Extension]
extensions = [Extension]
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 :: Language
baseLanguage = Language
bLang, extensions :: [Extension]
extensions = [Extension]
exts [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
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 :: Language
baseLanguage = Language
bLang, extensions :: [Extension]
extensions = [Extension]
exts [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
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 :: 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
  Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
ReadMode
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
  Handle -> IO FilePath
hGetContents Handle
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. [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 (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. [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