{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Parser for Haskell Modules to get all Haskell Language Extensions used.
-}

module Extensions.Module
       ( parseFile
       , parseSource
       , parseSourceWithPath

         -- * Internal Parsers
       , extensionsP
       , singleExtensionsP
       , extensionP
       , languagePragmaP
       , optionsGhcP
       , pragmaP
       , commentP
       , cppP
       ) where

import Data.ByteString (ByteString)
import Data.Char (toLower, toUpper)
import Data.Either (partitionEithers)
import Data.Foldable (traverse_)
import Data.Functor ((<&>))
import Data.List (nub)
import Data.List.NonEmpty (NonEmpty (..))
import System.Directory (doesFileExist)
import Text.Parsec (alphaNum, between, char, eof, many, many1, manyTill, noneOf, oneOf, parse,
                    sepBy1, try, (<|>))
import Text.Parsec.ByteString (Parser)
import Text.Parsec.Char (anyChar, endOfLine, letter, newline, space, spaces, string)
import Text.Read (readMaybe)

import Extensions.Types (ModuleParseError (..), OnOffExtension (..), ParsedExtensions (..),
                         SafeHaskellExtension (..), readOnOffExtension)

import qualified Data.ByteString as BS


-- | Internal data type for known and unknown extensions.
data ParsedExtension
    = KnownExtension OnOffExtension
    | SafeExtension SafeHaskellExtension
    | UnknownExtension String

handleParsedExtensions :: [ParsedExtension] -> Either ModuleParseError ParsedExtensions
handleParsedExtensions :: [ParsedExtension] -> Either ModuleParseError ParsedExtensions
handleParsedExtensions = ([String], [Either SafeHaskellExtension OnOffExtension])
-> Either ModuleParseError ParsedExtensions
handleResult (([String], [Either SafeHaskellExtension OnOffExtension])
 -> Either ModuleParseError ParsedExtensions)
-> ([ParsedExtension]
    -> ([String], [Either SafeHaskellExtension OnOffExtension]))
-> [ParsedExtension]
-> Either ModuleParseError ParsedExtensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String (Either SafeHaskellExtension OnOffExtension)]
-> ([String], [Either SafeHaskellExtension OnOffExtension])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either String (Either SafeHaskellExtension OnOffExtension)]
 -> ([String], [Either SafeHaskellExtension OnOffExtension]))
-> ([ParsedExtension]
    -> [Either String (Either SafeHaskellExtension OnOffExtension)])
-> [ParsedExtension]
-> ([String], [Either SafeHaskellExtension OnOffExtension])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedExtension
 -> Either String (Either SafeHaskellExtension OnOffExtension))
-> [ParsedExtension]
-> [Either String (Either SafeHaskellExtension OnOffExtension)]
forall a b. (a -> b) -> [a] -> [b]
map ParsedExtension
-> Either String (Either SafeHaskellExtension OnOffExtension)
toEither
  where
    toEither :: ParsedExtension -> Either String (Either SafeHaskellExtension OnOffExtension)
    toEither :: ParsedExtension
-> Either String (Either SafeHaskellExtension OnOffExtension)
toEither (UnknownExtension ext :: String
ext) = String
-> Either String (Either SafeHaskellExtension OnOffExtension)
forall a b. a -> Either a b
Left String
ext
    toEither (KnownExtension ext :: OnOffExtension
ext)   = Either SafeHaskellExtension OnOffExtension
-> Either String (Either SafeHaskellExtension OnOffExtension)
forall a b. b -> Either a b
Right (Either SafeHaskellExtension OnOffExtension
 -> Either String (Either SafeHaskellExtension OnOffExtension))
-> Either SafeHaskellExtension OnOffExtension
-> Either String (Either SafeHaskellExtension OnOffExtension)
forall a b. (a -> b) -> a -> b
$ OnOffExtension -> Either SafeHaskellExtension OnOffExtension
forall a b. b -> Either a b
Right OnOffExtension
ext
    toEither (SafeExtension ext :: SafeHaskellExtension
ext)    = Either SafeHaskellExtension OnOffExtension
-> Either String (Either SafeHaskellExtension OnOffExtension)
forall a b. b -> Either a b
Right (Either SafeHaskellExtension OnOffExtension
 -> Either String (Either SafeHaskellExtension OnOffExtension))
-> Either SafeHaskellExtension OnOffExtension
-> Either String (Either SafeHaskellExtension OnOffExtension)
forall a b. (a -> b) -> a -> b
$ SafeHaskellExtension -> Either SafeHaskellExtension OnOffExtension
forall a b. a -> Either a b
Left SafeHaskellExtension
ext

    -- Make sure that there is no conflicting 'SafeHaskellExtension's.
    handleResult
        :: ([String], [Either SafeHaskellExtension OnOffExtension])
        -> Either ModuleParseError ParsedExtensions
    handleResult :: ([String], [Either SafeHaskellExtension OnOffExtension])
-> Either ModuleParseError ParsedExtensions
handleResult (unknown :: [String]
unknown, knownAndSafe :: [Either SafeHaskellExtension OnOffExtension]
knownAndSafe) = case [String]
unknown of
        []   -> let (safe :: [SafeHaskellExtension]
safe, known :: [OnOffExtension]
known) = [Either SafeHaskellExtension OnOffExtension]
-> ([SafeHaskellExtension], [OnOffExtension])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SafeHaskellExtension OnOffExtension]
knownAndSafe in case [SafeHaskellExtension] -> [SafeHaskellExtension]
forall a. Eq a => [a] -> [a]
nub [SafeHaskellExtension]
safe of
            []   -> ParsedExtensions -> Either ModuleParseError ParsedExtensions
forall a b. b -> Either a b
Right $WParsedExtensions :: [OnOffExtension] -> Maybe SafeHaskellExtension -> ParsedExtensions
ParsedExtensions
                { parsedExtensionsAll :: [OnOffExtension]
parsedExtensionsAll = [OnOffExtension]
known
                , parsedExtensionsSafe :: Maybe SafeHaskellExtension
parsedExtensionsSafe = Maybe SafeHaskellExtension
forall a. Maybe a
Nothing
                }
            [s :: SafeHaskellExtension
s]  -> ParsedExtensions -> Either ModuleParseError ParsedExtensions
forall a b. b -> Either a b
Right $WParsedExtensions :: [OnOffExtension] -> Maybe SafeHaskellExtension -> ParsedExtensions
ParsedExtensions
                { parsedExtensionsAll :: [OnOffExtension]
parsedExtensionsAll = [OnOffExtension]
known
                , parsedExtensionsSafe :: Maybe SafeHaskellExtension
parsedExtensionsSafe = SafeHaskellExtension -> Maybe SafeHaskellExtension
forall a. a -> Maybe a
Just SafeHaskellExtension
s
                }
            s :: SafeHaskellExtension
s:ss :: [SafeHaskellExtension]
ss -> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. a -> Either a b
Left (ModuleParseError -> Either ModuleParseError ParsedExtensions)
-> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. (a -> b) -> a -> b
$ NonEmpty SafeHaskellExtension -> ModuleParseError
ModuleSafeHaskellConflict (NonEmpty SafeHaskellExtension -> ModuleParseError)
-> NonEmpty SafeHaskellExtension -> ModuleParseError
forall a b. (a -> b) -> a -> b
$ SafeHaskellExtension
s SafeHaskellExtension
-> [SafeHaskellExtension] -> NonEmpty SafeHaskellExtension
forall a. a -> [a] -> NonEmpty a
:| [SafeHaskellExtension]
ss
        x :: String
x:xs :: [String]
xs -> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. a -> Either a b
Left (ModuleParseError -> Either ModuleParseError ParsedExtensions)
-> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. (a -> b) -> a -> b
$ NonEmpty String -> ModuleParseError
UnknownExtensions (NonEmpty String -> ModuleParseError)
-> NonEmpty String -> ModuleParseError
forall a b. (a -> b) -> a -> b
$ String
x String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
xs

{- | By the given file path, reads the file and returns 'ParsedExtensions', if
parsing succeeds.
-}
parseFile :: FilePath -> IO (Either ModuleParseError ParsedExtensions)
parseFile :: String -> IO (Either ModuleParseError ParsedExtensions)
parseFile file :: String
file = String -> IO Bool
doesFileExist String
file IO Bool
-> (Bool -> IO (Either ModuleParseError ParsedExtensions))
-> IO (Either ModuleParseError ParsedExtensions)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \hasFile :: Bool
hasFile ->
    if Bool
hasFile
    then String -> ByteString -> Either ModuleParseError ParsedExtensions
parseSourceWithPath String
file (ByteString -> Either ModuleParseError ParsedExtensions)
-> IO ByteString -> IO (Either ModuleParseError ParsedExtensions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file
    else Either ModuleParseError ParsedExtensions
-> IO (Either ModuleParseError ParsedExtensions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ModuleParseError ParsedExtensions
 -> IO (Either ModuleParseError ParsedExtensions))
-> Either ModuleParseError ParsedExtensions
-> IO (Either ModuleParseError ParsedExtensions)
forall a b. (a -> b) -> a -> b
$ ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. a -> Either a b
Left (ModuleParseError -> Either ModuleParseError ParsedExtensions)
-> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. (a -> b) -> a -> b
$ String -> ModuleParseError
FileNotFound String
file

{- | By the given file path and file source content, returns 'ParsedExtensions',
if parsing succeeds.

This function takes a path to a Haskell source file. The path is only used for
error message. Pass empty string or use 'parseSource', if you don't have a path
to a Haskell module.
-}
parseSourceWithPath :: FilePath -> ByteString -> Either ModuleParseError ParsedExtensions
parseSourceWithPath :: String -> ByteString -> Either ModuleParseError ParsedExtensions
parseSourceWithPath path :: String
path src :: ByteString
src = case Parsec ByteString () [ParsedExtension]
-> String -> ByteString -> Either ParseError [ParsedExtension]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec ByteString () [ParsedExtension]
extensionsP String
path ByteString
src of
    Left err :: ParseError
err         -> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. a -> Either a b
Left (ModuleParseError -> Either ModuleParseError ParsedExtensions)
-> ModuleParseError -> Either ModuleParseError ParsedExtensions
forall a b. (a -> b) -> a -> b
$ ParseError -> ModuleParseError
ParsecError ParseError
err
    Right parsedExts :: [ParsedExtension]
parsedExts -> [ParsedExtension] -> Either ModuleParseError ParsedExtensions
handleParsedExtensions [ParsedExtension]
parsedExts

{- | By the given file source content, returns 'ParsedExtensions', if parsing
succeeds.
-}
parseSource :: ByteString -> Either ModuleParseError ParsedExtensions
parseSource :: ByteString -> Either ModuleParseError ParsedExtensions
parseSource = String -> ByteString -> Either ModuleParseError ParsedExtensions
parseSourceWithPath "SourceName"

{- | The main parser of 'ParsedExtension'.

It parses language pragmas or comments until end of file or the first line with
the function/import/module name.
-}
extensionsP :: Parser [ParsedExtension]
extensionsP :: Parsec ByteString () [ParsedExtension]
extensionsP = [[ParsedExtension]] -> [ParsedExtension]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ParsedExtension]] -> [ParsedExtension])
-> ParsecT ByteString () Identity [[ParsedExtension]]
-> Parsec ByteString () [ParsedExtension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec ByteString () [ParsedExtension]
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity [[ParsedExtension]]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill
    (Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec ByteString () [ParsedExtension]
singleExtensionsP Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec ByteString () [ParsedExtension]
forall a. Parser [a]
optionsGhcP Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec ByteString () [ParsedExtension]
forall a. Parser [a]
commentP Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec ByteString () [ParsedExtension]
forall a. Parser [a]
cppP)
    (ParsecT ByteString () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (() ()
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter))

{- | Single LANGUAGE pragma parser.

@
 \{\-# LANGUAGE XXX
  , YYY ,
  ZZZ
 #\-\}
@
-}
singleExtensionsP :: Parser [ParsedExtension]
singleExtensionsP :: Parsec ByteString () [ParsedExtension]
singleExtensionsP =
    Parsec ByteString () [ParsedExtension]
-> Parsec ByteString () [ParsedExtension]
forall a. Parser a -> Parser a
languagePragmaP (Parser ParsedExtension -> Parsec ByteString () [ParsedExtension]
forall a. Parser a -> Parser [a]
commaSep (ParsecT ByteString () Identity ()
nonExtP ParsecT ByteString () Identity ()
-> Parser ParsedExtension -> Parser ParsedExtension
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParsedExtension
extensionP Parser ParsedExtension
-> ParsecT ByteString () Identity () -> Parser ParsedExtension
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
nonExtP) Parsec ByteString () [ParsedExtension]
-> ParsecT ByteString () Identity ()
-> Parsec ByteString () [ParsedExtension]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)

nonExtP :: Parser ()
nonExtP :: ParsecT ByteString () Identity ()
nonExtP = () ()
-> ParsecT ByteString () Identity [[Any]]
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ByteString () Identity [Any]
-> ParsecT ByteString () Identity [[Any]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT ByteString () Identity [Any]
-> ParsecT ByteString () Identity [Any]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT ByteString () Identity [Any]
forall a. Parser [a]
cppP ParsecT ByteString () Identity [Any]
-> ParsecT ByteString () Identity [Any]
-> ParsecT ByteString () Identity [Any]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT ByteString () Identity [Any]
-> ParsecT ByteString () Identity [Any]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT ByteString () Identity [Any]
forall a. Parser [a]
commentP)

{- | Parses all known and unknown 'OnOffExtension's or 'SafeHaskellExtension's.
-}
extensionP :: Parser ParsedExtension
extensionP :: Parser ParsedExtension
extensionP = (ParsecT ByteString () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces) ParsecT ByteString () Identity String
-> (String -> ParsedExtension) -> Parser ParsedExtension
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \txt :: String
txt ->
    case String -> Maybe OnOffExtension
readOnOffExtension String
txt of
        Just ext :: OnOffExtension
ext -> OnOffExtension -> ParsedExtension
KnownExtension OnOffExtension
ext
        Nothing  -> case String -> Maybe SafeHaskellExtension
forall a. Read a => String -> Maybe a
readMaybe @SafeHaskellExtension String
txt of
            Just ext :: SafeHaskellExtension
ext -> SafeHaskellExtension -> ParsedExtension
SafeExtension SafeHaskellExtension
ext
            Nothing  -> String -> ParsedExtension
UnknownExtension String
txt

{- | Parser for standard language pragma keywords: @\{\-\# LANGUAGE XXX \#\-\}@
-}
languagePragmaP :: Parser a -> Parser a
languagePragmaP :: Parser a -> Parser a
languagePragmaP = ParsecT ByteString () Identity () -> Parser a -> Parser a
forall a. ParsecT ByteString () Identity () -> Parser a -> Parser a
pragmaP (ParsecT ByteString () Identity () -> Parser a -> Parser a)
-> ParsecT ByteString () Identity () -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ String -> ParsecT ByteString () Identity ()
istringP "LANGUAGE"

{- | Parser for GHC options pragma keywords: @\{\-\# OPTIONS_GHC YYY \#\-\}@
-}
optionsGhcP :: Parser [a]
optionsGhcP :: Parser [a]
optionsGhcP = [] [a] -> ParsecT ByteString () Identity [String] -> Parser [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ByteString () Identity [String]
-> ParsecT ByteString () Identity [String]
forall a. Parser a -> Parser a
optionsGhcPragmaP (ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT ByteString () Identity String
ghcOptionP)
  where
    ghcOptionP :: Parser String
    ghcOptionP :: ParsecT ByteString () Identity String
ghcOptionP = ParsecT ByteString () Identity ()
newLines ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-') ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
newLines

optionsGhcPragmaP :: Parser a -> Parser a
optionsGhcPragmaP :: Parser a -> Parser a
optionsGhcPragmaP = ParsecT ByteString () Identity () -> Parser a -> Parser a
forall a. ParsecT ByteString () Identity () -> Parser a -> Parser a
pragmaP (ParsecT ByteString () Identity () -> Parser a -> Parser a)
-> ParsecT ByteString () Identity () -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ String -> ParsecT ByteString () Identity ()
istringP "OPTIONS_GHC"

-- | Parser for case-insensitive strings.
istringP :: String -> Parser ()
istringP :: String -> ParsecT ByteString () Identity ()
istringP = (Char -> ParsecT ByteString () Identity Char)
-> String -> ParsecT ByteString () Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Char -> ParsecT ByteString () Identity Char)
 -> String -> ParsecT ByteString () Identity ())
-> (Char -> ParsecT ByteString () Identity Char)
-> String
-> ParsecT ByteString () Identity ()
forall a b. (a -> b) -> a -> b
$ \c :: Char
c -> String -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char -> Char
toUpper Char
c, Char -> Char
toLower Char
c]

{- | Parser for GHC pragmas with a given pragma word.
-}
pragmaP :: Parser () -> Parser a -> Parser a
pragmaP :: ParsecT ByteString () Identity () -> Parser a -> Parser a
pragmaP pragmaNameP :: ParsecT ByteString () Identity ()
pragmaNameP p :: Parser a
p = ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String -> Parser a -> Parser a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between
    (String -> ParsecT ByteString () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "{-#") (String -> ParsecT ByteString () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "#-}" ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
newLines)
    (ParsecT ByteString () Identity ()
newLines ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity ()
nonExtP ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity ()
pragmaNameP ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity ()
newLines ParsecT ByteString () Identity () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT ByteString () Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
newLines)

-- | Comma separated parser. Newlines and spaces are allowed around comma.
commaSep :: Parser a -> Parser [a]
commaSep :: Parser a -> Parser [a]
commaSep p :: Parser a
p = Parser a
p Parser a -> ParsecT ByteString () Identity Char -> Parser [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy1` (ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT ByteString () Identity Char
 -> ParsecT ByteString () Identity Char)
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT ByteString () Identity ()
newLines ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ',' ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
newLines)

{- | Haskell comment parser.
Supports both single-line comments:

  @
  -- I am a single comment
  @

and multi-line comments:

  @
  \{\- I
  AM
  MULTILINE
  \-\}
  @
-}
commentP :: Parser [a]
commentP :: Parser [a]
commentP = ParsecT ByteString () Identity ()
newLines ParsecT ByteString () Identity () -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser [a] -> Parser [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [a]
forall a. Parser [a]
singleLineCommentP Parser [a] -> Parser [a] -> Parser [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [a] -> Parser [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser [a]
forall a. Parser [a]
multiLineCommentP) Parser [a] -> ParsecT ByteString () Identity () -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
newLines
  where
    singleLineCommentP :: Parser [a]
    singleLineCommentP :: Parser [a]
singleLineCommentP = [] [a] -> ParsecT ByteString () Identity String -> Parser [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
        (String -> ParsecT ByteString () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "--" ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (() ()
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine) ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT ByteString () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof))

    multiLineCommentP :: Parser [a]
    multiLineCommentP :: Parser [a]
multiLineCommentP = [] [a] -> ParsecT ByteString () Identity String -> Parser [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
        (String -> ParsecT ByteString () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "{-" ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT ByteString () Identity String
 -> ParsecT ByteString () Identity String)
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT ByteString () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "-}"))

{- | CPP syntax parser.

  @
  #if \_\_GLASGOW_HASKELL\_\_ < 810
  -- Could be more Language pragmas that should be parsed
  #endif
  @
-}
cppP :: Parser [a]
cppP :: Parser [a]
cppP =
    [] [a] -> ParsecT ByteString () Identity String -> Parser [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
       Parser [a] -> ParsecT ByteString () Identity Char -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '#' ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "-")
       Parser [a] -> ParsecT ByteString () Identity String -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine)
       Parser [a] -> ParsecT ByteString () Identity () -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
newLines

-- | Any combination of spaces and newlines.
newLines :: Parser ()
newLines :: ParsecT ByteString () Identity ()
newLines = () ()
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine)