{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Parser for fixity maps.
module Ormolu.Fixity.Parser
  ( parseDotOrmolu,
    parseFixityDeclaration,
    parseModuleReexportDeclaration,

    -- * Raw parsers
    pFixity,
    pOperator,
    pModuleName,
    pPackageName,

    -- * Internal
    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

-- | Parse textual representation of 'FixityOverrides'.
parseDotOrmolu ::
  -- | Location of the file we are parsing (only for parse errors)
  FilePath ->
  -- | File contents to parse
  Text ->
  -- | Parse result
  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

-- | Parse a single self-contained fixity declaration.
parseFixityDeclaration ::
  -- | Text to parse
  Text ->
  -- | Parse result
  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]
""

-- | Parse a single self-contained module re-export declaration.
parseModuleReexportDeclaration ::
  -- | Text to parse
  Text ->
  -- | Parse result
  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

-- | Parse a single fixity declaration, such as
--
-- > infixr 4 +++, >>>
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"
    ]

-- | See <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html>
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"

-- Internal predicates (exposed for testing)

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