module Language.Haskell.Exts (
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
, parseFile
, parseFileWithMode
, parseFileWithExts
, parseFileWithComments
, parseFileWithCommentsAndPragmas
, parseFileContents
, parseFileContentsWithMode
, parseFileContentsWithExts
, parseFileContentsWithComments
, 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
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
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
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]))
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
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
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
parseFileContents :: String -> ParseResult (Module SrcSpanInfo)
parseFileContents :: FilePath -> ParseResult (Module SrcSpanInfo)
parseFileContents = ParseMode -> FilePath -> ParseResult (Module SrcSpanInfo)
parseFileContentsWithMode ParseMode
defaultParseMode
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 })
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
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])
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
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
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