{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Fixity.Parser
( parseDotOrmolu,
parseFixityDeclaration,
parseModuleReexportDeclaration,
pFixity,
pOperator,
pModuleName,
pPackageName,
isIdentifierFirstChar,
isIdentifierConstituent,
isOperatorConstituent,
isPackageNameConstituent,
isModuleSegmentFirstChar,
isModuleSegmentConstituent,
)
where
import Control.Monad (void, when)
import Data.Bifunctor (bimap)
import Data.Char (isAlphaNum, isUpper)
import Data.Char qualified as Char
import Data.Either (partitionEithers)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import Distribution.ModuleName (ModuleName)
import Distribution.ModuleName qualified as ModuleName
import Distribution.Types.PackageName (PackageName, mkPackageName)
import Ormolu.Fixity
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L
type Parser = Parsec Void Text
parseDotOrmolu ::
FilePath ->
Text ->
Either (ParseErrorBundle Text Void) (FixityOverrides, ModuleReexports)
parseDotOrmolu :: [Char]
-> Text
-> Either
(ParseErrorBundle Text Void) (FixityOverrides, ModuleReexports)
parseDotOrmolu = Parsec Void Text (FixityOverrides, ModuleReexports)
-> [Char]
-> Text
-> Either
(ParseErrorBundle Text Void) (FixityOverrides, ModuleReexports)
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text (FixityOverrides, ModuleReexports)
pDotOrmolu
parseFixityDeclaration ::
Text ->
Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
parseFixityDeclaration :: Text -> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
parseFixityDeclaration = Parsec Void Text [(OpName, FixityInfo)]
-> [Char]
-> Text
-> Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec Void Text [(OpName, FixityInfo)]
pFixity Parsec Void Text [(OpName, FixityInfo)]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [(OpName, FixityInfo)]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
""
parseModuleReexportDeclaration ::
Text ->
Either
(ParseErrorBundle Text Void)
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
parseModuleReexportDeclaration :: Text
-> Either
(ParseErrorBundle Text Void)
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
parseModuleReexportDeclaration = Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
-> [Char]
-> Text
-> Either
(ParseErrorBundle Text Void)
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
pModuleReexport Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
-> ParsecT Void Text Identity ()
-> Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
""
pDotOrmolu :: Parser (FixityOverrides, ModuleReexports)
pDotOrmolu :: Parsec Void Text (FixityOverrides, ModuleReexports)
pDotOrmolu =
([[(OpName, FixityInfo)]] -> FixityOverrides)
-> ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ModuleReexports)
-> ([[(OpName, FixityInfo)]],
[(ModuleName, NonEmpty (Maybe PackageName, ModuleName))])
-> (FixityOverrides, ModuleReexports)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
(Map OpName FixityInfo -> FixityOverrides
FixityOverrides (Map OpName FixityInfo -> FixityOverrides)
-> ([[(OpName, FixityInfo)]] -> Map OpName FixityInfo)
-> [[(OpName, FixityInfo)]]
-> FixityOverrides
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(OpName, FixityInfo)] -> Map OpName FixityInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(OpName, FixityInfo)] -> Map OpName FixityInfo)
-> ([[(OpName, FixityInfo)]] -> [(OpName, FixityInfo)])
-> [[(OpName, FixityInfo)]]
-> Map OpName FixityInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(OpName, FixityInfo)]] -> [(OpName, FixityInfo)]
forall a. Monoid a => [a] -> a
mconcat)
(Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> ModuleReexports
ModuleReexports (Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> ModuleReexports)
-> ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName)))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ModuleReexports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName))
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort (Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName)))
-> ([(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName)))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName))
-> [(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
forall a. Semigroup a => a -> a -> a
(<>))
(([[(OpName, FixityInfo)]],
[(ModuleName, NonEmpty (Maybe PackageName, ModuleName))])
-> (FixityOverrides, ModuleReexports))
-> ([Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ([[(OpName, FixityInfo)]],
[(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]))
-> [Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> (FixityOverrides, ModuleReexports)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> ([[(OpName, FixityInfo)]],
[(ModuleName, NonEmpty (Maybe PackageName, ModuleName))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
([Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> (FixityOverrides, ModuleReexports))
-> ParsecT
Void
Text
Identity
[Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
-> Parsec Void Text (FixityOverrides, ModuleReexports)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
Void
Text
Identity
(Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
-> ParsecT
Void
Text
Identity
[Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT
Void
Text
Identity
(Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
configLine
Parsec Void Text (FixityOverrides, ModuleReexports)
-> ParsecT Void Text Identity ()
-> Parsec Void Text (FixityOverrides, ModuleReexports)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
where
configLine :: ParsecT
Void
Text
Identity
(Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
configLine = do
Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
x <- Parsec Void Text [(OpName, FixityInfo)]
-> Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
-> ParsecT
Void
Text
Identity
(Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP Parsec Void Text [(OpName, FixityInfo)]
pFixity Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
pModuleReexport
ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
-> ParsecT
Void
Text
Identity
(Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName)))
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Either
[(OpName, FixityInfo)]
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
x
pFixity :: Parser [(OpName, FixityInfo)]
pFixity :: Parsec Void Text [(OpName, FixityInfo)]
pFixity = do
FixityDirection
fiDirection <- Parser FixityDirection
pFixityDirection
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
Int
offsetAtPrecedence <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
fiPrecedence <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fiPrecedence Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$
(ParseError Text Void -> ParseError Text Void)
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> ParseError s e) -> m a -> m a
region
(Int -> ParseError Text Void -> ParseError Text Void
forall s e. Int -> ParseError s e -> ParseError s e
setErrorOffset Int
offsetAtPrecedence)
([Char] -> ParsecT Void Text Identity ()
forall a. [Char] -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"precedence should not be greater than 9")
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
[OpName]
ops <- ParsecT Void Text Identity OpName
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [OpName]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ParsecT Void Text Identity OpName
pOperator (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace)
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
let fixityInfo :: FixityInfo
fixityInfo = FixityInfo {Int
FixityDirection
fiDirection :: FixityDirection
fiPrecedence :: Int
fiDirection :: FixityDirection
fiPrecedence :: Int
..}
[(OpName, FixityInfo)] -> Parsec Void Text [(OpName, FixityInfo)]
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((,FixityInfo
fixityInfo) (OpName -> (OpName, FixityInfo))
-> [OpName] -> [(OpName, FixityInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OpName]
ops)
pFixityDirection :: Parser FixityDirection
pFixityDirection :: Parser FixityDirection
pFixityDirection =
[Parser FixityDirection] -> Parser FixityDirection
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ FixityDirection
InfixL FixityDirection
-> ParsecT Void Text Identity (Tokens Text)
-> Parser FixityDirection
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"infixl",
FixityDirection
InfixR FixityDirection
-> ParsecT Void Text Identity (Tokens Text)
-> Parser FixityDirection
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"infixr",
FixityDirection
InfixN FixityDirection
-> ParsecT Void Text Identity (Tokens Text)
-> Parser FixityDirection
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"infix"
]
pOperator :: Parser OpName
pOperator :: ParsecT Void Text Identity OpName
pOperator = Text -> OpName
OpName (Text -> OpName)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OpName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Text
tickedOperator ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
normalOperator)
where
tickedOperator :: ParsecT Void Text Identity Text
tickedOperator = ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT Void Text Identity (Token Text)
tick ParsecT Void Text Identity (Token Text)
tick ParsecT Void Text Identity Text
haskellIdentifier
tick :: ParsecT Void Text Identity (Token Text)
tick = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'
haskellIdentifier :: ParsecT Void Text Identity Text
haskellIdentifier =
Char -> Text -> Text
T.cons
(Char -> Text -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
ParsecT Void Text Identity (Text -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isIdentifierConstituent
normalOperator :: ParsecT Void Text Identity (Tokens Text)
normalOperator =
Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"operator character") Char -> Bool
Token Text -> Bool
isOperatorConstituent
pModuleReexport :: Parser (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
pModuleReexport :: Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
pModuleReexport = do
ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"module")
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
ModuleName
exportingModule <- Parser ModuleName
pModuleName
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"exports")
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
Maybe PackageName
mexportedPackage <-
ParsecT Void Text Identity PackageName
-> ParsecT Void Text Identity (Maybe PackageName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity PackageName
-> ParsecT Void Text Identity (Maybe PackageName))
-> ParsecT Void Text Identity PackageName
-> ParsecT Void Text Identity (Maybe PackageName)
forall a b. (a -> b) -> a -> b
$
ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity PackageName
-> ParsecT Void Text Identity PackageName
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"') ParsecT Void Text Identity PackageName
pPackageName ParsecT Void Text Identity PackageName
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity PackageName
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
ModuleName
exportedModule <- Parser ModuleName
pModuleName
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
(ModuleName, NonEmpty (Maybe PackageName, ModuleName))
-> Parsec
Void Text (ModuleName, NonEmpty (Maybe PackageName, ModuleName))
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
exportingModule, (Maybe PackageName, ModuleName)
-> NonEmpty (Maybe PackageName, ModuleName)
forall a. a -> NonEmpty a
NE.singleton (Maybe PackageName
mexportedPackage, ModuleName
exportedModule))
pModuleName :: Parser ModuleName
pModuleName :: Parser ModuleName
pModuleName =
[Char] -> ModuleName
forall a. IsString a => [Char] -> a
ModuleName.fromString ([Char] -> ModuleName)
-> ([[Char]] -> [Char]) -> [[Char]] -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"."
([[Char]] -> ModuleName)
-> ParsecT Void Text Identity [[Char]] -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [[Char]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ParsecT Void Text Identity [Char]
ParsecT Void Text Identity [Token Text]
pModuleSegment (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.')
Parser ModuleName -> [Char] -> Parser ModuleName
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"module name"
where
pModuleSegment :: ParsecT Void Text Identity [Token Text]
pModuleSegment = do
Token Text
x <- (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isModuleSegmentFirstChar ParsecT Void Text Identity (Token Text)
-> [Char] -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"capital letter"
[Token Text]
xs <-
ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
( (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isModuleSegmentConstituent
ParsecT Void Text Identity (Token Text)
-> [Char] -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"module segment continuation"
)
[Token Text] -> ParsecT Void Text Identity [Token Text]
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Token Text
x Token Text -> [Token Text] -> [Token Text]
forall a. a -> [a] -> [a]
: [Token Text]
xs)
pPackageName :: Parser PackageName
pPackageName :: ParsecT Void Text Identity PackageName
pPackageName =
[Char] -> PackageName
mkPackageName ([Char] -> PackageName)
-> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isPackageNameConstituent) ParsecT Void Text Identity PackageName
-> [Char] -> ParsecT Void Text Identity PackageName
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"package name"
isIdentifierFirstChar :: Char -> Bool
isIdentifierFirstChar :: Char -> Bool
isIdentifierFirstChar = Char -> Bool
Char.isLetter
isIdentifierConstituent :: Char -> Bool
isIdentifierConstituent :: Char -> Bool
isIdentifierConstituent Char
x = Char -> Bool
Char.isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
isOperatorConstituent :: Char -> Bool
isOperatorConstituent :: Char -> Bool
isOperatorConstituent Char
x =
(Char -> Bool
Char.isSymbol Char
x Bool -> Bool -> Bool
|| Char -> Bool
Char.isPunctuation Char
x)
Bool -> Bool -> Bool
&& (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
isPackageNameConstituent :: Char -> Bool
isPackageNameConstituent :: Char -> Bool
isPackageNameConstituent Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
x
isModuleSegmentFirstChar :: Char -> Bool
isModuleSegmentFirstChar :: Char -> Bool
isModuleSegmentFirstChar Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
x
isModuleSegmentConstituent :: Char -> Bool
isModuleSegmentConstituent :: Char -> Bool
isModuleSegmentConstituent Char
x =
Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
x