{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Ormolu.Fixity.Parser
( parseFixityMap,
parseFixityDeclaration,
)
where
import qualified Data.Char as Char
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import Data.Void (Void)
import Ormolu.Fixity.Internal
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void Text
parseFixityMap ::
FilePath ->
Text ->
Either (ParseErrorBundle Text Void) FixityMap
parseFixityMap :: FilePath -> Text -> Either (ParseErrorBundle Text Void) FixityMap
parseFixityMap = Parsec Void Text FixityMap
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) FixityMap
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text FixityMap
pFixityMap
parseFixityDeclaration ::
Text ->
Either (ParseErrorBundle Text Void) [(String, FixityInfo)]
parseFixityDeclaration :: Text
-> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)]
parseFixityDeclaration = Parsec Void Text [(FilePath, FixityInfo)]
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) [(FilePath, FixityInfo)]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec Void Text [(FilePath, FixityInfo)]
pFixity Parsec Void Text [(FilePath, FixityInfo)]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [(FilePath, FixityInfo)]
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) FilePath
""
pFixityMap :: Parser FixityMap
pFixityMap :: Parsec Void Text FixityMap
pFixityMap =
(FixityInfo -> FixityInfo -> FixityInfo)
-> [(FilePath, FixityInfo)] -> FixityMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith FixityInfo -> FixityInfo -> FixityInfo
forall a. Semigroup a => a -> a -> a
(<>) ([(FilePath, FixityInfo)] -> FixityMap)
-> ([[(FilePath, FixityInfo)]] -> [(FilePath, FixityInfo)])
-> [[(FilePath, FixityInfo)]]
-> FixityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(FilePath, FixityInfo)]] -> [(FilePath, FixityInfo)]
forall a. Monoid a => [a] -> a
mconcat
([[(FilePath, FixityInfo)]] -> FixityMap)
-> ParsecT Void Text Identity [[(FilePath, FixityInfo)]]
-> Parsec Void Text FixityMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text [(FilePath, FixityInfo)]
-> ParsecT Void Text Identity [[(FilePath, FixityInfo)]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parsec Void Text [(FilePath, FixityInfo)]
pFixity Parsec Void Text [(FilePath, FixityInfo)]
-> ParsecT Void Text Identity Char
-> Parsec Void Text [(FilePath, FixityInfo)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parsec Void Text [(FilePath, FixityInfo)]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [(FilePath, FixityInfo)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
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)
Parsec Void Text FixityMap
-> ParsecT Void Text Identity () -> Parsec Void Text FixityMap
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
pFixity :: Parser [(String, FixityInfo)]
pFixity :: Parsec Void Text [(FilePath, FixityInfo)]
pFixity = do
Maybe FixityDirection
fiDirection <- FixityDirection -> Maybe FixityDirection
forall a. a -> Maybe a
Just (FixityDirection -> Maybe FixityDirection)
-> ParsecT Void Text Identity FixityDirection
-> ParsecT Void Text Identity (Maybe FixityDirection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity FixityDirection
pFixityDirection
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
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
fiMinPrecedence <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
let fiMaxPrecedence :: Int
fiMaxPrecedence = Int
fiMinPrecedence
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
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
[FilePath]
ops <- ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ParsecT Void Text Identity FilePath
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
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 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 :: Maybe FixityDirection -> Int -> Int -> FixityInfo
FixityInfo {Int
Maybe FixityDirection
fiMaxPrecedence :: Int
fiMinPrecedence :: Int
fiDirection :: Maybe FixityDirection
fiMaxPrecedence :: Int
fiMinPrecedence :: Int
fiDirection :: Maybe FixityDirection
..}
[(FilePath, FixityInfo)]
-> Parsec Void Text [(FilePath, FixityInfo)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((,FixityInfo
fixityInfo) (FilePath -> (FilePath, FixityInfo))
-> [FilePath] -> [(FilePath, FixityInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
ops)
pFixityDirection :: Parser FixityDirection
pFixityDirection :: ParsecT Void Text Identity FixityDirection
pFixityDirection =
[ParsecT Void Text Identity FixityDirection]
-> ParsecT Void Text Identity FixityDirection
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ FixityDirection
InfixL FixityDirection
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity FixityDirection
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 Text
-> ParsecT Void Text Identity FixityDirection
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 Text
-> ParsecT Void Text Identity FixityDirection
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 String
pOperator :: ParsecT Void Text Identity FilePath
pOperator = ParsecT Void Text Identity FilePath
tickedOperator ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity FilePath
normalOperator
where
tickedOperator :: ParsecT Void Text Identity FilePath
tickedOperator = ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
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 FilePath
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 FilePath
haskellIdentifier = do
Char
x <- ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
FilePath
xs <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
'\'')
FilePath -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs)
normalOperator :: ParsecT Void Text Identity FilePath
normalOperator = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
operatorChar
operatorChar :: ParsecT Void Text Identity Char
operatorChar =
(Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy
(\Token Text
x -> (Char -> Bool
Char.isSymbol Char
Token Text
x Bool -> Bool -> Bool
|| Char -> Bool
Char.isPunctuation Char
Token Text
x) Bool -> Bool -> Bool
&& Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`')
ParsecT Void Text Identity Char
-> FilePath -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"operator character"