{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures   #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards  #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Brassica.SoundChange.Parse
    ( parseRule
    , parseSoundChanges
      -- ** Re-export
    , errorBundlePretty
    ) where

import Data.Char (isSpace)
import Data.Foldable (asum)
import Data.Maybe (isNothing, isJust, fromJust)
import Data.Void (Void)

import Control.Applicative.Permutations
import Control.Monad (void, guard)

import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

import Brassica.SoundChange.Types

type Parser = Parsec Void String

class ParseLexeme (a :: LexemeType) where
    parseLexeme :: Parser (Lexeme CategorySpec a)

-- space consumer which does not match newlines
sc :: Parser ()
sc :: Parser ()
sc = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
space1' (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment [Char]
";") forall (f :: * -> *) a. Alternative f => f a
empty
  where
    -- adapted from megaparsec source: like 'space1', but does not
    -- consume newlines (which are important for rule separation)
    space1' :: Parser ()
space1' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just [Char]
"white space") (Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Eq a => a -> a -> Bool
/=Char
'\n'))

-- space consumer which matches newlines
scn :: Parser ()
scn :: Parser ()
scn = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment [Char]
";") forall (f :: * -> *) a. Alternative f => f a
empty

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc

symbol :: String -> Parser String
symbol :: [Char] -> Parser [Char]
symbol = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc

keyChars :: [Char]
keyChars :: [Char]
keyChars = [Char]
"#[](){}>\\→/_^%~*@"

nonzero :: Parser Int
nonzero :: Parser Int
nonzero = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"nonzero postive number" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    Int
n <- forall a. Parser a -> Parser a
lexeme forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
nforall a. Ord a => a -> a -> Bool
>Int
0
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n

parseGrapheme :: Parser Grapheme
parseGrapheme :: Parser Grapheme
parseGrapheme = forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$
    Grapheme
GBoundary forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'#'
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Grapheme
GMulti forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
parseGrapheme'

parseGrapheme' :: Parser String
parseGrapheme' :: Parser [Char]
parseGrapheme' = forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ do
    Maybe (Token [Char])
star <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*')
    [Char]
rest <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
isSpace forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
keyChars)))
    Maybe (Token [Char])
nocat <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'~')
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. a -> b -> a
const (Char
'*'forall a. a -> [a] -> [a]
:)) Maybe (Token [Char])
star forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. a -> b -> a
const (forall a. [a] -> [a] -> [a]
++[Char]
"~")) Maybe (Token [Char])
nocat
        forall a b. (a -> b) -> a -> b
$ [Char]
rest

parseExplicitCategory :: ParseLexeme a => Parser (Lexeme CategorySpec a)
parseExplicitCategory :: forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseExplicitCategory = forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseExplicitCategory'

parseExplicitCategory' :: ParseLexeme a => Parser (CategorySpec a)
parseExplicitCategory' :: forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseExplicitCategory' =
    forall (a :: LexemeType).
[(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> CategorySpec a
CategorySpec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill forall (a :: LexemeType).
ParseLexeme a =>
Parser
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification ([Char] -> Parser [Char]
symbol [Char]
"]"))

-- This is unused currently, but convenient to keep around just in case
-- parseCategory :: ParseLexeme a => Parser (Lexeme CategorySpec a)
-- parseCategory = Category <$> parseCategory'

parseCategory' :: ParseLexeme a => Parser (CategorySpec a)
parseCategory' :: forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseCategory' = forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseExplicitCategory' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: LexemeType). [Char] -> CategorySpec a
MustInline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
parseGrapheme'

parseCategoryStandalone
    :: Parser (String, CategorySpec 'AnyPart)
parseCategoryStandalone :: Parser ([Char], CategorySpec 'AnyPart)
parseCategoryStandalone = do
    [Char]
g <- Parser [Char]
parseGrapheme'
    [Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"="
    [(CategoryModification,
  Either Grapheme [Lexeme CategorySpec 'AnyPart])]
mods <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall (a :: LexemeType).
ParseLexeme a =>
Parser
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
g, forall (a :: LexemeType).
[(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> CategorySpec a
CategorySpec [(CategoryModification,
  Either Grapheme [Lexeme CategorySpec 'AnyPart])]
mods)

parseFeature :: Parser FeatureSpec
parseFeature :: Parser FeatureSpec
parseFeature = do
    [Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"feature"
    Maybe [Char]
featureBaseName <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Parser [Char]
parseGrapheme' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser [Char]
symbol [Char]
"="
    CategorySpec 'AnyPart
featureBaseValues <- forall (a :: LexemeType).
[(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> CategorySpec a
CategorySpec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall (a :: LexemeType).
ParseLexeme a =>
Parser
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification
    [([Char], CategorySpec 'AnyPart)]
featureDerived <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Char] -> Parser [Char]
symbol [Char]
"/" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ([Char], CategorySpec 'AnyPart)
parseCategoryStandalone) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureSpec { Maybe [Char]
featureBaseName :: Maybe [Char]
featureBaseName :: Maybe [Char]
featureBaseName, CategorySpec 'AnyPart
featureBaseValues :: CategorySpec 'AnyPart
featureBaseValues :: CategorySpec 'AnyPart
featureBaseValues, [([Char], CategorySpec 'AnyPart)]
featureDerived :: [([Char], CategorySpec 'AnyPart)]
featureDerived :: [([Char], CategorySpec 'AnyPart)]
featureDerived }

parseCategoryModification
    :: ParseLexeme a
    => Parser (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification :: forall (a :: LexemeType).
ParseLexeme a =>
Parser
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification = (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity CategoryModification
parsePrefix
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"{" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme ([Char] -> Parser [Char]
symbol [Char]
"}")))
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Grapheme
parseGrapheme))
  where
    parsePrefix :: ParsecT Void [Char] Identity CategoryModification
parsePrefix =
        (CategoryModification
Intersect forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+')
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CategoryModification
Subtract forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-')
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure CategoryModification
Union

parseDirective :: Parser Directive
parseDirective :: Parser Directive
parseDirective = do
    Bool
overwrite <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Parser [Char]
symbol [Char]
"new")
    [Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"categories" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn
    [CategoryDefinition]
cs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$
        FeatureSpec -> CategoryDefinition
DefineFeature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FeatureSpec
parseFeature forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> CategorySpec 'AnyPart -> CategoryDefinition
DefineCategory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser ([Char], CategorySpec 'AnyPart)
parseCategoryStandalone forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn)
    [Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"end" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> [CategoryDefinition] -> Directive
Categories Bool
overwrite [CategoryDefinition]
cs

parseOptional :: ParseLexeme a => Parser (Lexeme CategorySpec a)
parseOptional :: forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseOptional = forall (category :: LexemeType -> *) (a :: LexemeType).
[Lexeme category a] -> Lexeme category a
Optional forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ([Char] -> Parser [Char]
symbol [Char]
"(") ([Char] -> Parser [Char]
symbol [Char]
")") (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme)

parseGeminate :: Parser (Lexeme CategorySpec a)
parseGeminate :: forall (a :: LexemeType). Parser (Lexeme CategorySpec a)
parseGeminate = forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a
Geminate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
">"

parseMetathesis :: Parser (Lexeme CategorySpec 'Replacement)
parseMetathesis :: Parser (Lexeme CategorySpec 'Replacement)
parseMetathesis = forall (category :: LexemeType -> *). Lexeme category 'Replacement
Metathesis forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"\\"

parseWildcard :: (ParseLexeme a, OneOf a 'Target 'Env) => Parser (Lexeme CategorySpec a)
parseWildcard :: forall (a :: LexemeType).
(ParseLexeme a, OneOf a 'Target 'Env) =>
Parser (Lexeme CategorySpec a)
parseWildcard = forall (a :: LexemeType) (category :: LexemeType -> *).
OneOf a 'Target 'Env =>
Lexeme category a -> Lexeme category a
Wildcard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"^" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme)

parseDiscard :: Parser (Lexeme CategorySpec 'Replacement)
parseDiscard :: Parser (Lexeme CategorySpec 'Replacement)
parseDiscard = forall (category :: LexemeType -> *). Lexeme category 'Replacement
Discard forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"~"

parseKleene :: OneOf a 'Target 'Env => Lexeme CategorySpec a -> Parser (Lexeme CategorySpec a)
parseKleene :: forall (a :: LexemeType).
OneOf a 'Target 'Env =>
Lexeme CategorySpec a -> Parser (Lexeme CategorySpec a)
parseKleene Lexeme CategorySpec a
l =
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ forall (a :: LexemeType) (category :: LexemeType -> *).
OneOf a 'Target 'Env =>
Lexeme category a -> Lexeme category a
Kleene Lexeme CategorySpec a
l forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser [Char]
parseGrapheme')
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Lexeme CategorySpec a
l

parseMultiple :: Parser (Lexeme CategorySpec 'Replacement)
parseMultiple :: Parser (Lexeme CategorySpec 'Replacement)
parseMultiple = forall (category :: LexemeType -> *).
category 'Replacement -> Lexeme category 'Replacement
Multiple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"@?" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseCategory')

parseBackreference :: forall a. ParseLexeme a => Parser (Lexeme CategorySpec a)
parseBackreference :: forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseBackreference = forall (category :: LexemeType -> *) (a :: LexemeType).
Int -> category a -> Lexeme category a
Backreference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
nonzero) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseCategory'

instance ParseLexeme 'Target where
    parseLexeme :: Parser (Lexeme CategorySpec 'Target)
parseLexeme = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseExplicitCategory
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseOptional
        , forall (a :: LexemeType). Parser (Lexeme CategorySpec a)
parseGeminate
        , forall (a :: LexemeType).
(ParseLexeme a, OneOf a 'Target 'Env) =>
Parser (Lexeme CategorySpec a)
parseWildcard
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseBackreference
        , forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Grapheme
parseGrapheme
        ] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (a :: LexemeType).
OneOf a 'Target 'Env =>
Lexeme CategorySpec a -> Parser (Lexeme CategorySpec a)
parseKleene

instance ParseLexeme 'Replacement where
    parseLexeme :: Parser (Lexeme CategorySpec 'Replacement)
parseLexeme = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseExplicitCategory
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseOptional
        , Parser (Lexeme CategorySpec 'Replacement)
parseMetathesis
        , Parser (Lexeme CategorySpec 'Replacement)
parseDiscard
        , forall (a :: LexemeType). Parser (Lexeme CategorySpec a)
parseGeminate
        , Parser (Lexeme CategorySpec 'Replacement)
parseMultiple
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseBackreference
        , forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Grapheme
parseGrapheme
        ]

instance ParseLexeme 'Env where
    parseLexeme :: Parser (Lexeme CategorySpec 'Env)
parseLexeme = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseExplicitCategory
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseOptional
        , forall (a :: LexemeType). Parser (Lexeme CategorySpec a)
parseGeminate
        , forall (a :: LexemeType).
(ParseLexeme a, OneOf a 'Target 'Env) =>
Parser (Lexeme CategorySpec a)
parseWildcard
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseBackreference
        , forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Grapheme
parseGrapheme
        ] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (a :: LexemeType).
OneOf a 'Target 'Env =>
Lexeme CategorySpec a -> Parser (Lexeme CategorySpec a)
parseKleene

instance ParseLexeme 'AnyPart where
    parseLexeme :: Parser (Lexeme CategorySpec 'AnyPart)
parseLexeme = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseExplicitCategory
        , forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseOptional
        , forall (category :: LexemeType -> *) (a :: LexemeType).
Grapheme -> Lexeme category a
Grapheme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Grapheme
parseGrapheme
        ]

parseLexemes :: ParseLexeme a => Parser [Lexeme CategorySpec a]
parseLexemes :: forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme

parseFlags :: Parser Flags
parseFlags :: Parser Flags
parseFlags = forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ Bool -> Direction -> Bool -> Bool -> Flags
Flags
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Parser [Char]
symbol [Char]
"-x"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Direction
LTR ((Direction
LTR forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"-ltr") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Direction
RTL forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"-rtl"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Parser [Char]
symbol [Char]
"-1"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Parser [Char]
symbol [Char]
"-?"))

ruleParser :: Parser (Rule CategorySpec)
ruleParser :: Parser (Rule CategorySpec)
ruleParser = do
    -- This is an inlined version of 'match' from @megaparsec@;
    -- 'match' itself would be tricky to use here, since it would need
    -- to wrap multiple parsers rather than just one
    Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    [Char]
s <- forall e s (m :: * -> *). MonadParsec e s m => m s
getInput

    Flags
flags <- Parser Flags
parseFlags
    [Lexeme CategorySpec 'Target]
target <- forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes
    Token [Char]
_ <- forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char]
"/→"
    [Lexeme CategorySpec 'Replacement]
replacement <- forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes

    [([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])]
envs' <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall a b. (a -> b) -> a -> b
$ [Char] -> Parser [Char]
symbol [Char]
"//"  -- for exceptions
        [Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"/"
        [Lexeme CategorySpec 'Env]
env1 <- forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes
        [Char]
_ <- [Char] -> Parser [Char]
symbol [Char]
"_"
        [Lexeme CategorySpec 'Env]
env2 <- forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Lexeme CategorySpec 'Env]
env1, [Lexeme CategorySpec 'Env]
env2)
    let envs :: [([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])]
envs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])]
envs' then [([], [])] else [([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])]
envs'

    Maybe ([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])
exception <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"//" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser [Char]
symbol [Char]
"_" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes

    Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
scn   -- consume newline after rule if present

    Int
o' <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    let plaintext :: [Char]
plaintext = forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
notNewline forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (forall s. Stream s => Int -> s -> Maybe (Tokens s, s)
takeN_ (Int
o' forall a. Num a => a -> a -> a
- Int
o) [Char]
s)
    forall (m :: * -> *) a. Monad m => a -> m a
return Rule{environment :: [([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])]
environment=[([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])]
envs, [Char]
[Lexeme CategorySpec 'Target]
[Lexeme CategorySpec 'Replacement]
Maybe ([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])
Flags
plaintext :: [Char]
flags :: Flags
exception :: Maybe ([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])
replacement :: [Lexeme CategorySpec 'Replacement]
target :: [Lexeme CategorySpec 'Target]
plaintext :: [Char]
exception :: Maybe ([Lexeme CategorySpec 'Env], [Lexeme CategorySpec 'Env])
replacement :: [Lexeme CategorySpec 'Replacement]
target :: [Lexeme CategorySpec 'Target]
flags :: Flags
..}
  where
    notNewline :: Char -> Bool
notNewline Char
c = (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\r')

-- | Parse a 'String' in Brassica sound change syntax into a
-- 'Rule'. Returns 'Left' if the input string is malformed.
--
-- For details on the syntax, refer to <https://github.com/bradrn/brassica/blob/v0.2.0/Documentation.md#basic-rule-syntax>.
parseRule :: String -> Either (ParseErrorBundle String Void) (Rule CategorySpec)
parseRule :: [Char] -> Either (ParseErrorBundle [Char] Void) (Rule CategorySpec)
parseRule = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parser ()
scn forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Rule CategorySpec)
ruleParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
""

-- | Parse a list of 'SoundChanges'.
parseSoundChanges :: String -> Either (ParseErrorBundle String Void) (SoundChanges CategorySpec Directive)
parseSoundChanges :: [Char]
-> Either
     (ParseErrorBundle [Char] Void)
     (SoundChanges CategorySpec Directive)
parseSoundChanges = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parser ()
scn forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity (SoundChanges CategorySpec Directive)
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
""
  where
    parser :: ParsecT Void [Char] Identity (SoundChanges CategorySpec Directive)
parser = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
        forall (c :: LexemeType -> *) decl. decl -> Statement c decl
DirectiveS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Directive
parseDirective
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (c :: LexemeType -> *) decl. Rule c -> Statement c decl
RuleS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Rule CategorySpec)
ruleParser