module Require.Parser
( Parser
, requireDirective
, Megaparsec.parseMaybe
) where
import qualified Data.Char as Char
import qualified Data.Text as Text
import Relude
import Require.Types
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as Megaparsec
type Parser = Megaparsec.Parsec Void Text
requireDirective :: Parser RequireDirective
requireDirective :: Parser RequireDirective
requireDirective = do
RequireDirective
directive <- [Parser RequireDirective] -> Parser RequireDirective
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ RequireInfo -> RequireDirective
RequireDirective (RequireInfo -> RequireDirective)
-> ParsecT Void Text Identity RequireInfo
-> Parser RequireDirective
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity RequireInfo
requireInfo
, RequireDirective
AutorequireDirective RequireDirective
-> ParsecT Void Text Identity Text -> Parser RequireDirective
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)
Megaparsec.string Tokens Text
"autorequire"
, Parser RequireDirective
moduleDirective
]
ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space
ParsecT Void Text Identity ()
skipLineComment
RequireDirective -> Parser RequireDirective
forall (f :: * -> *) a. Applicative f => a -> f a
pure RequireDirective
directive
requireInfo :: Parser RequireInfo
requireInfo :: ParsecT Void Text Identity RequireInfo
requireInfo = do
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string Tokens Text
"require"
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space1
ModuleName
module' <- Parser ModuleName
moduleNameParser
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space
Maybe [Char]
alias' <- ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char])
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Megaparsec.try (ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char]))
-> ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
Megaparsec.option Maybe [Char]
forall a. Maybe a
Nothing (ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char]))
-> ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string Tokens Text
"as"
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space1
[Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity (Maybe [Char])
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]
Megaparsec.some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Megaparsec.alphaNumChar
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space
Maybe [Char]
types' <- Maybe [Char]
-> ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
Megaparsec.option Maybe [Char]
forall a. Maybe a
Nothing (ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char]))
-> ParsecT Void Text Identity (Maybe [Char])
-> ParsecT Void Text Identity (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'('
[Char]
t' <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Megaparsec.many (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Megaparsec.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)
Megaparsec.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)
Megaparsec.char Char
Token Text
' ')
ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
')'
Maybe [Char] -> ParsecT Void Text Identity (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> ParsecT Void Text Identity (Maybe [Char]))
-> Maybe [Char] -> ParsecT Void Text Identity (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
t'
let defaultAlias :: Text
defaultAlias = ModuleName -> Text
defaultModuleAlias ModuleName
module'
RequireInfo -> ParsecT Void Text Identity RequireInfo
forall (m :: * -> *) a. Monad m => a -> m a
return
RequireInfo :: ModuleName -> Text -> Text -> RequireInfo
RequireInfo
{ riFullModuleName :: ModuleName
riFullModuleName = ModuleName
module',
riModuleAlias :: Text
riModuleAlias = Text -> ([Char] -> Text) -> Maybe [Char] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultAlias [Char] -> Text
forall a. ToText a => a -> Text
toText Maybe [Char]
alias',
riImportedTypes :: Text
riImportedTypes = Text -> ([Char] -> Text) -> Maybe [Char] -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultAlias [Char] -> Text
forall a. ToText a => a -> Text
toText Maybe [Char]
types'
}
moduleDirective :: Parser RequireDirective
moduleDirective :: Parser RequireDirective
moduleDirective = do
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string Tokens Text
"module"
ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space1
ModuleName
module' <- Parser ModuleName
moduleNameParser
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> 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)
Megaparsec.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
RequireDirective -> Parser RequireDirective
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequireDirective -> Parser RequireDirective)
-> RequireDirective -> Parser RequireDirective
forall a b. (a -> b) -> a -> b
$ ModuleName -> RequireDirective
ModuleDirective ModuleName
module'
moduleNameParser :: Parser ModuleName
moduleNameParser :: Parser ModuleName
moduleNameParser =
(Text -> ModuleName)
-> ParsecT Void Text Identity Text -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ModuleName
ModuleName (ParsecT Void Text Identity Text -> Parser ModuleName)
-> ParsecT Void Text Identity Text -> Parser ModuleName
forall a b. (a -> b) -> a -> 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)
Megaparsec.takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing ((Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text))
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c ->
Char -> Bool
Char.isAlphaNum Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
skipLineComment :: Parser ()
= ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Megaparsec.optional (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$
Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string Tokens Text
"--"
ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Megaparsec.space1 ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
Megaparsec.alphaNumChar ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof)
ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> 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)
Megaparsec.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
defaultModuleAlias :: ModuleName -> Text
defaultModuleAlias :: ModuleName -> Text
defaultModuleAlias = (Char -> Bool) -> Text -> Text
Text.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (Text -> Text) -> (ModuleName -> Text) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName