-----------------------------------------------------------------------------
-- |
-- 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 fp :: 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 exts :: [Extension]
exts fp :: 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 p :: ParseMode
p fp :: 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 p :: ParseMode
p fp :: 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 p :: ParseMode
p fp :: 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 pmode :: ParseMode
pmode str :: 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 exts :: [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 fn :: FilePath
fn oldLang :: Language
oldLang exts :: [Extension]
exts ign :: Bool
ign _ _ _) rawStr :: 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
            (bLang :: Language
bLang, extraExts :: [Extension]
extraExts) =
                case (Bool
ign, FilePath -> Maybe (Maybe Language, [Extension])
readExtensions FilePath
md) of
                  (False, Just (mLang :: Maybe Language
mLang, es :: [Extension]
es)) ->
                       (Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe Language
oldLang Maybe Language
mLang, [Extension]
es)
                  _ -> (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 fn :: FilePath
fn oldLang :: Language
oldLang exts :: [Extension]
exts ign :: Bool
ign _ _ _) rawStr :: 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
            (bLang :: Language
bLang, extraExts :: [Extension]
extraExts) =
                case (Bool
ign, FilePath -> Maybe (Maybe Language, [Extension])
readExtensions FilePath
md) of
                  (False, Just (mLang :: Maybe Language
mLang, es :: [Extension]
es)) ->
                       (Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe Language
oldLang Maybe Language
mLang, [Extension]
es)
                  _ -> (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 str :: FilePath
str = case FilePath -> ParseResult [ModulePragma SrcSpanInfo]
getTopPragmas FilePath
str of
        ParseOk pgms :: [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
        _            -> Maybe (Maybe Language, [Extension])
forall a. Maybe a
Nothing
  where getExts :: ModulePragma l -> [Either Language Extension]
        getExts :: ModulePragma l -> [Either Language Extension]
getExts (LanguagePragma _ ns :: [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 _ = []

        readExt :: Name l -> Either Language Extension
readExt (Ident _ e :: FilePath
e) =
            case FilePath -> Language
classifyLanguage FilePath
e of
              UnknownLanguage _ -> 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
              lang :: 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 "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' lacc :: Maybe a
lacc eacc :: [a]
eacc [] = (Maybe a, [a]) -> Maybe (Maybe a, [a])
forall a. a -> Maybe a
Just (Maybe a
lacc, [a]
eacc)
        extractLang' Nothing eacc :: [a]
eacc (Left l :: a
l : rest :: [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 l1 :: a
l1) eacc :: [a]
eacc (Left l2 :: a
l2:rest :: [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' lacc :: Maybe a
lacc eacc :: [a]
eacc (Right ext :: a
ext : rest :: [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 (('#':_):rest :: [FilePath]
rest) = [FilePath]
rest
        f x :: [FilePath]
x = [FilePath]
x

delit :: String -> String -> String
delit :: FilePath -> FilePath -> FilePath
delit fn :: FilePath
fn = if ".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 fp :: 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 r :: ParseResult (Module SrcSpanInfo, [Comment])
r =
    case ParseResult (Module SrcSpanInfo, [Comment])
r of
        ParseOk (m :: Module SrcSpanInfo
m, comments :: [Comment]
comments) ->
            let (pragmas :: [Comment]
pragmas, comments' :: [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 _ l :: SrcSpan
l s :: 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 1 FilePath
s
                      pragLike :: Comment -> Bool
pragLike (Comment b :: Bool
b _ s :: FilePath
s) = Bool
b Bool -> Bool -> Bool
&& FilePath -> Bool
pcond FilePath
s
                      pcond :: FilePath -> Bool
pcond s :: 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
> 1 Bool -> Bool -> Bool
&& Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take 1 FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "#" Bool -> Bool -> Bool
&& FilePath -> Char
forall a. [a] -> a
last FilePath
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '#'
        ParseFailed l :: SrcLoc
l s :: FilePath
s ->  SrcLoc
-> FilePath
-> ParseResult (Module SrcSpanInfo, [Comment], [UnknownPragma])
forall a. SrcLoc -> FilePath -> ParseResult a
ParseFailed SrcLoc
l FilePath
s