module Language.Haskell.Stylish.Parse
( parseModule
) where
import Data.List (isPrefixOf, nub)
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Language.Haskell.Exts as H
import Language.Haskell.Stylish.Config
import Language.Haskell.Stylish.Step
defaultExtensions :: [H.Extension]
defaultExtensions = map H.EnableExtension
[ H.GADTs
, H.HereDocuments
, H.KindSignatures
, H.NewQualifiedOperators
, H.PatternGuards
, H.StandaloneDeriving
, H.UnicodeSyntax
]
unCpp :: String -> String
unCpp = unlines . go False . lines
where
go _ [] = []
go isMultiline (x : xs) =
let isCpp = isMultiline || listToMaybe x == Just '#'
nextMultiline = isCpp && not (null x) && last x == '\\'
in (if isCpp then "" else x) : go nextMultiline xs
unShebang :: String -> String
unShebang str =
let (shebangs, other) = break (not . ("#!" `isPrefixOf`)) (lines str) in
unlines $ map (const "") shebangs ++ other
dropBom :: String -> String
dropBom ('\xfeff' : str) = str
dropBom str = str
parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module
parseModule extraExts mfp string = do
let noPrefixes = unShebang . dropBom $ string
extraExts' = map H.classifyExtension extraExts
(lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noPrefixes
exts = nub $ fileExts ++ extraExts' ++ defaultExtensions
fp = fromMaybe "<unknown>" mfp
mode = H.defaultParseMode
{ H.extensions = exts
, H.fixities = Nothing
, H.baseLanguage = case lang of
Nothing -> H.baseLanguage H.defaultParseMode
Just l -> l
}
processed = if H.EnableExtension H.CPP `elem` exts
then unCpp noPrefixes
else noPrefixes
case H.parseModuleWithComments mode processed of
H.ParseOk md -> return md
err -> Left $
"Language.Haskell.Stylish.Parse.parseModule: could not parse " ++
fp ++ ": " ++ show err