{-# 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 = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
space1' (Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment [Char]
Tokens [Char]
";") Parser ()
forall a. ParsecT Void [Char] Identity a
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' = ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ())
-> ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
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]
"white space") (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (Token [Char] -> Bool) -> Token [Char] -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
Token [Char] -> Bool
isSpace (Token [Char] -> Bool -> Bool)
-> (Token [Char] -> Bool) -> Token [Char] -> Bool
forall a b.
(Token [Char] -> a -> b)
-> (Token [Char] -> a) -> Token [Char] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))

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

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

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

parseGrapheme' :: Parser String
parseGrapheme' :: Parser [Char]
parseGrapheme' = Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme (Parser [Char] -> Parser [Char]) -> Parser [Char] -> Parser [Char]
forall a b. (a -> b) -> a -> b
$ do
    Maybe Char
star <- ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
'*')
    [Char]
rest <- Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Token [Char] -> Bool) -> Token [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool)
-> (Token [Char] -> Bool) -> Token [Char] -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
Token [Char] -> Bool
isSpace (Token [Char] -> Bool -> Bool)
-> (Token [Char] -> Bool) -> Token [Char] -> Bool
forall a b.
(Token [Char] -> a -> b)
-> (Token [Char] -> a) -> Token [Char] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
keyChars)))
    Maybe Char
nocat <- ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
'~')
    [Char] -> Parser [Char]
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Parser [Char])
-> ([Char] -> [Char]) -> [Char] -> Parser [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ([Char] -> [Char])
-> (Char -> [Char] -> [Char]) -> Maybe Char -> [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char] -> [Char]
forall a. a -> a
id (([Char] -> [Char]) -> Char -> [Char] -> [Char]
forall a b. a -> b -> a
const (Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)) Maybe Char
star ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ([Char] -> [Char])
-> (Char -> [Char] -> [Char]) -> Maybe Char -> [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char] -> [Char]
forall a. a -> a
id (([Char] -> [Char]) -> Char -> [Char] -> [Char]
forall a b. a -> b -> a
const ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"~")) Maybe Char
nocat
        ([Char] -> Parser [Char]) -> [Char] -> Parser [Char]
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 = CategorySpec a -> Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
category a -> Lexeme category a
Category (CategorySpec a -> Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity (CategorySpec a)
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' =
    [(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> CategorySpec a
forall (a :: LexemeType).
[(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> CategorySpec a
CategorySpec ([(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
 -> CategorySpec a)
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> ParsecT Void [Char] Identity (CategorySpec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"[" Parser [Char]
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  Void
  [Char]
  Identity
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
-> Parser [Char]
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
someTill ParsecT
  Void
  [Char]
  Identity
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
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' = Parser (CategorySpec a)
forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseExplicitCategory' Parser (CategorySpec a)
-> Parser (CategorySpec a) -> Parser (CategorySpec a)
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> CategorySpec a
forall (a :: LexemeType). [Char] -> CategorySpec a
MustInline ([Char] -> CategorySpec a)
-> Parser [Char] -> Parser (CategorySpec a)
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 <- ParsecT
  Void
  [Char]
  Identity
  (CategoryModification,
   Either Grapheme [Lexeme CategorySpec 'AnyPart])
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification,
       Either Grapheme [Lexeme CategorySpec 'AnyPart])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT
  Void
  [Char]
  Identity
  (CategoryModification,
   Either Grapheme [Lexeme CategorySpec 'AnyPart])
forall (a :: LexemeType).
ParseLexeme a =>
Parser
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification
    ([Char], CategorySpec 'AnyPart)
-> Parser ([Char], CategorySpec 'AnyPart)
forall a. a -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
g, [(CategoryModification,
  Either Grapheme [Lexeme CategorySpec 'AnyPart])]
-> CategorySpec 'AnyPart
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 <- Parser [Char] -> ParsecT Void [Char] Identity (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [Char] -> ParsecT Void [Char] Identity (Maybe [Char]))
-> Parser [Char] -> ParsecT Void [Char] Identity (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser [Char] -> Parser [Char]) -> Parser [Char] -> Parser [Char]
forall a b. (a -> b) -> a -> b
$ Parser [Char]
parseGrapheme' Parser [Char] -> Parser [Char] -> Parser [Char]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser [Char]
symbol [Char]
"="
    CategorySpec 'AnyPart
featureBaseValues <- [(CategoryModification,
  Either Grapheme [Lexeme CategorySpec 'AnyPart])]
-> CategorySpec 'AnyPart
forall (a :: LexemeType).
[(CategoryModification, Either Grapheme [Lexeme CategorySpec a])]
-> CategorySpec a
CategorySpec ([(CategoryModification,
   Either Grapheme [Lexeme CategorySpec 'AnyPart])]
 -> CategorySpec 'AnyPart)
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification,
       Either Grapheme [Lexeme CategorySpec 'AnyPart])]
-> ParsecT Void [Char] Identity (CategorySpec 'AnyPart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Void
  [Char]
  Identity
  (CategoryModification,
   Either Grapheme [Lexeme CategorySpec 'AnyPart])
-> ParsecT
     Void
     [Char]
     Identity
     [(CategoryModification,
       Either Grapheme [Lexeme CategorySpec 'AnyPart])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT
  Void
  [Char]
  Identity
  (CategoryModification,
   Either Grapheme [Lexeme CategorySpec 'AnyPart])
forall (a :: LexemeType).
ParseLexeme a =>
Parser
  (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
parseCategoryModification
    [([Char], CategorySpec 'AnyPart)]
featureDerived <- Parser ([Char], CategorySpec 'AnyPart)
-> ParsecT Void [Char] Identity [([Char], CategorySpec 'AnyPart)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Char] -> Parser [Char]
symbol [Char]
"/" Parser [Char]
-> Parser ([Char], CategorySpec 'AnyPart)
-> Parser ([Char], CategorySpec 'AnyPart)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ([Char], CategorySpec 'AnyPart)
parseCategoryStandalone) ParsecT Void [Char] Identity [([Char], CategorySpec 'AnyPart)]
-> Parser ()
-> ParsecT Void [Char] Identity [([Char], CategorySpec 'AnyPart)]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn
    FeatureSpec -> Parser FeatureSpec
forall a. a -> ParsecT Void [Char] Identity a
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 = (,)
    (CategoryModification
 -> Either Grapheme [Lexeme CategorySpec a]
 -> (CategoryModification, Either Grapheme [Lexeme CategorySpec a]))
-> ParsecT Void [Char] Identity CategoryModification
-> ParsecT
     Void
     [Char]
     Identity
     (Either Grapheme [Lexeme CategorySpec a]
      -> (CategoryModification, Either Grapheme [Lexeme CategorySpec a]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity CategoryModification
parsePrefix
    ParsecT
  Void
  [Char]
  Identity
  (Either Grapheme [Lexeme CategorySpec a]
   -> (CategoryModification, Either Grapheme [Lexeme CategorySpec a]))
-> ParsecT
     Void [Char] Identity (Either Grapheme [Lexeme CategorySpec a])
-> ParsecT
     Void
     [Char]
     Identity
     (CategoryModification, Either Grapheme [Lexeme CategorySpec a])
forall a b.
ParsecT Void [Char] Identity (a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ([Lexeme CategorySpec a] -> Either Grapheme [Lexeme CategorySpec a]
forall a b. b -> Either a b
Right ([Lexeme CategorySpec a]
 -> Either Grapheme [Lexeme CategorySpec a])
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
-> ParsecT
     Void [Char] Identity (Either Grapheme [Lexeme CategorySpec a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"{" Parser [Char]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> Parser [Char]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme ([Char] -> Parser [Char]
symbol [Char]
"}")))
        ParsecT
  Void [Char] Identity (Either Grapheme [Lexeme CategorySpec a])
-> ParsecT
     Void [Char] Identity (Either Grapheme [Lexeme CategorySpec a])
-> ParsecT
     Void [Char] Identity (Either Grapheme [Lexeme CategorySpec a])
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Grapheme -> Either Grapheme [Lexeme CategorySpec a]
forall a b. a -> Either a b
Left (Grapheme -> Either Grapheme [Lexeme CategorySpec a])
-> Parser Grapheme
-> ParsecT
     Void [Char] Identity (Either Grapheme [Lexeme CategorySpec a])
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 CategoryModification
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity CategoryModification
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
'+')
        ParsecT Void [Char] Identity CategoryModification
-> ParsecT Void [Char] Identity CategoryModification
-> ParsecT Void [Char] Identity CategoryModification
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CategoryModification
Subtract CategoryModification
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity CategoryModification
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
'-')
        ParsecT Void [Char] Identity CategoryModification
-> ParsecT Void [Char] Identity CategoryModification
-> ParsecT Void [Char] Identity CategoryModification
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CategoryModification
-> ParsecT Void [Char] Identity CategoryModification
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CategoryModification
Union

parseDirective :: Parser Directive
parseDirective :: Parser Directive
parseDirective = Parser Directive
parseCategoriesDirective Parser Directive -> Parser Directive -> Parser Directive
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Directive
parseExtraDirective
  where
    parseExtraDirective :: Parser Directive
parseExtraDirective = ([[Char]] -> Directive)
-> ParsecT Void [Char] Identity [[Char]] -> Parser Directive
forall a b.
(a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> Directive
ExtraGraphemes (ParsecT Void [Char] Identity [[Char]] -> Parser Directive)
-> ParsecT Void [Char] Identity [[Char]] -> Parser Directive
forall a b. (a -> b) -> a -> b
$
        [Char] -> Parser [Char]
symbol [Char]
"extra" Parser [Char]
-> ParsecT Void [Char] Identity [[Char]]
-> ParsecT Void [Char] Identity [[Char]]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Char] -> ParsecT Void [Char] Identity [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser [Char]
parseGrapheme' ParsecT Void [Char] Identity [[Char]]
-> Parser () -> ParsecT Void [Char] Identity [[Char]]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn

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

parseOptional :: ParseLexeme a => Parser (Lexeme CategorySpec a)
parseOptional :: forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseOptional = [Lexeme CategorySpec a] -> Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
[Lexeme category a] -> Lexeme category a
Optional ([Lexeme CategorySpec a] -> Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
-> Parser [Char]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
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]
")") (ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity [Lexeme CategorySpec a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme)

parseGeminate :: Parser (Lexeme CategorySpec a)
parseGeminate :: forall (a :: LexemeType). Parser (Lexeme CategorySpec a)
parseGeminate = Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a
Geminate Lexeme CategorySpec a
-> Parser [Char]
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
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 = Lexeme CategorySpec 'Replacement
forall (category :: LexemeType -> *). Lexeme category 'Replacement
Metathesis Lexeme CategorySpec 'Replacement
-> Parser [Char] -> Parser (Lexeme CategorySpec 'Replacement)
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"\\"

parseWildcard :: ParseLexeme a => Parser (Lexeme CategorySpec a)
parseWildcard :: forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseWildcard = Lexeme CategorySpec a -> Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Wildcard (Lexeme CategorySpec a -> Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"^" Parser [Char]
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme)

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

parseKleene :: Lexeme CategorySpec a -> Parser (Lexeme CategorySpec a)
parseKleene :: forall (a :: LexemeType).
Lexeme CategorySpec a -> Parser (Lexeme CategorySpec a)
parseKleene Lexeme CategorySpec a
l =
    ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a. Parser a -> Parser a
lexeme (ParsecT Void [Char] Identity (Lexeme CategorySpec a)
 -> ParsecT Void [Char] Identity (Lexeme CategorySpec a))
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a b. (a -> b) -> a -> b
$ Lexeme CategorySpec a -> Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
Lexeme category a -> Lexeme category a
Kleene Lexeme CategorySpec a
l Lexeme CategorySpec a
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token [Char]
'*' ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> Parser ()
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char] -> Parser ()
forall a. ParsecT Void [Char] Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser [Char]
parseGrapheme')
    ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Lexeme CategorySpec a
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a. a -> ParsecT Void [Char] Identity 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 = CategorySpec 'Replacement -> Lexeme CategorySpec 'Replacement
forall (category :: LexemeType -> *).
category 'Replacement -> Lexeme category 'Replacement
Multiple (CategorySpec 'Replacement -> Lexeme CategorySpec 'Replacement)
-> ParsecT Void [Char] Identity (CategorySpec 'Replacement)
-> Parser (Lexeme CategorySpec 'Replacement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"@?" Parser [Char]
-> ParsecT Void [Char] Identity (CategorySpec 'Replacement)
-> ParsecT Void [Char] Identity (CategorySpec 'Replacement)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity (CategorySpec 'Replacement)
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 = Int -> CategorySpec a -> Lexeme CategorySpec a
forall (category :: LexemeType -> *) (a :: LexemeType).
Int -> category a -> Lexeme category a
Backreference (Int -> CategorySpec a -> Lexeme CategorySpec a)
-> Parser Int
-> ParsecT
     Void [Char] Identity (CategorySpec a -> Lexeme CategorySpec a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
symbol [Char]
"@" Parser [Char] -> Parser Int -> Parser Int
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
nonzero) ParsecT
  Void [Char] Identity (CategorySpec a -> Lexeme CategorySpec a)
-> ParsecT Void [Char] Identity (CategorySpec a)
-> ParsecT Void [Char] Identity (Lexeme CategorySpec a)
forall a b.
ParsecT Void [Char] Identity (a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void [Char] Identity (CategorySpec a)
forall (a :: LexemeType). ParseLexeme a => Parser (CategorySpec a)
parseCategory'

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

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

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

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

parseFlags :: Parser Flags
parseFlags :: Parser Flags
parseFlags = Permutation (ParsecT Void [Char] Identity) Flags -> Parser Flags
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Permutation m a -> m a
runPermutation (Permutation (ParsecT Void [Char] Identity) Flags -> Parser Flags)
-> Permutation (ParsecT Void [Char] Identity) Flags -> Parser Flags
forall a b. (a -> b) -> a -> b
$ Bool -> Direction -> Bool -> Sporadicity -> Flags
Flags
    (Bool -> Direction -> Bool -> Sporadicity -> Flags)
-> Permutation (ParsecT Void [Char] Identity) Bool
-> Permutation
     (ParsecT Void [Char] Identity)
     (Direction -> Bool -> Sporadicity -> Flags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity Bool
-> Permutation (ParsecT Void [Char] Identity) Bool
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [Char] -> Bool)
-> ParsecT Void [Char] Identity (Maybe [Char])
-> ParsecT Void [Char] Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> ParsecT Void [Char] Identity (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Parser [Char]
symbol [Char]
"-x"))
    Permutation
  (ParsecT Void [Char] Identity)
  (Direction -> Bool -> Sporadicity -> Flags)
-> Permutation (ParsecT Void [Char] Identity) Direction
-> Permutation
     (ParsecT Void [Char] Identity) (Bool -> Sporadicity -> Flags)
forall a b.
Permutation (ParsecT Void [Char] Identity) (a -> b)
-> Permutation (ParsecT Void [Char] Identity) a
-> Permutation (ParsecT Void [Char] Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Direction
-> ParsecT Void [Char] Identity Direction
-> Permutation (ParsecT Void [Char] Identity) Direction
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Direction
LTR ((Direction
LTR Direction
-> Parser [Char] -> ParsecT Void [Char] Identity Direction
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"-ltr") ParsecT Void [Char] Identity Direction
-> ParsecT Void [Char] Identity Direction
-> ParsecT Void [Char] Identity Direction
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Direction
RTL Direction
-> Parser [Char] -> ParsecT Void [Char] Identity Direction
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"-rtl"))
    Permutation
  (ParsecT Void [Char] Identity) (Bool -> Sporadicity -> Flags)
-> Permutation (ParsecT Void [Char] Identity) Bool
-> Permutation
     (ParsecT Void [Char] Identity) (Sporadicity -> Flags)
forall a b.
Permutation (ParsecT Void [Char] Identity) (a -> b)
-> Permutation (ParsecT Void [Char] Identity) a
-> Permutation (ParsecT Void [Char] Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void [Char] Identity Bool
-> Permutation (ParsecT Void [Char] Identity) Bool
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Char] -> Bool)
-> ParsecT Void [Char] Identity (Maybe [Char])
-> ParsecT Void [Char] Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> ParsecT Void [Char] Identity (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Parser [Char]
symbol [Char]
"-1"))
    Permutation (ParsecT Void [Char] Identity) (Sporadicity -> Flags)
-> Permutation (ParsecT Void [Char] Identity) Sporadicity
-> Permutation (ParsecT Void [Char] Identity) Flags
forall a b.
Permutation (ParsecT Void [Char] Identity) (a -> b)
-> Permutation (ParsecT Void [Char] Identity) a
-> Permutation (ParsecT Void [Char] Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sporadicity
-> ParsecT Void [Char] Identity Sporadicity
-> Permutation (ParsecT Void [Char] Identity) Sporadicity
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Sporadicity
ApplyAlways
        ((Sporadicity
PerApplication Sporadicity
-> Parser [Char] -> ParsecT Void [Char] Identity Sporadicity
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
symbol [Char]
"-??") ParsecT Void [Char] Identity Sporadicity
-> ParsecT Void [Char] Identity Sporadicity
-> ParsecT Void [Char] Identity Sporadicity
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Sporadicity
PerWord Sporadicity
-> Parser [Char] -> ParsecT Void [Char] Identity Sporadicity
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [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 <- Parser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    [Char]
s <- Parser [Char]
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput

    Flags
flags <- Parser Flags
parseFlags
    [Lexeme CategorySpec 'Matched]
target <- Parser (Lexeme CategorySpec 'Matched)
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill Parser (Lexeme CategorySpec 'Matched)
forall (a :: LexemeType).
ParseLexeme a =>
Parser (Lexeme CategorySpec a)
parseLexeme (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched])
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
forall a b. (a -> b) -> a -> b
$ ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (ParsecT Void [Char] Identity (Tokens [Char])
 -> ParsecT Void [Char] Identity (Tokens [Char]))
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a b. (a -> b) -> a -> b
$ [ParsecT Void [Char] Identity (Tokens [Char])]
-> ParsecT Void [Char] Identity (Tokens [Char])
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
choice
        [ Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Char]
Tokens [Char]
"/"
        , Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Char]
Tokens [Char]
"→"
        , Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Char]
Tokens [Char]
"->"
        ]
    [Lexeme CategorySpec 'Replacement]
replacement <- Parser [Lexeme CategorySpec 'Replacement]
forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes

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

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

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

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

filterParser :: Parser (Filter CategorySpec)
filterParser :: Parser (Filter CategorySpec)
filterParser = (([Char], [Lexeme CategorySpec 'Matched]) -> Filter CategorySpec)
-> ParsecT
     Void [Char] Identity ([Char], [Lexeme CategorySpec 'Matched])
-> Parser (Filter CategorySpec)
forall a b.
(a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> [Lexeme CategorySpec 'Matched] -> Filter CategorySpec)
-> ([Char], [Lexeme CategorySpec 'Matched]) -> Filter CategorySpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Lexeme CategorySpec 'Matched] -> Filter CategorySpec
forall (c :: LexemeType -> *).
[Char] -> [Lexeme c 'Matched] -> Filter c
Filter) (ParsecT
   Void [Char] Identity ([Char], [Lexeme CategorySpec 'Matched])
 -> Parser (Filter CategorySpec))
-> ParsecT
     Void [Char] Identity ([Char], [Lexeme CategorySpec 'Matched])
-> Parser (Filter CategorySpec)
forall a b. (a -> b) -> a -> b
$ ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
-> ParsecT
     Void
     [Char]
     Identity
     (Tokens [Char], [Lexeme CategorySpec 'Matched])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
 -> ParsecT
      Void
      [Char]
      Identity
      (Tokens [Char], [Lexeme CategorySpec 'Matched]))
-> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
-> ParsecT
     Void
     [Char]
     Identity
     (Tokens [Char], [Lexeme CategorySpec 'Matched])
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser [Char]
symbol [Char]
"filter" Parser [Char]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
-> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
forall (a :: LexemeType).
ParseLexeme a =>
Parser [Lexeme CategorySpec a]
parseLexemes ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
-> ParsecT Void [Char] Identity (Maybe ())
-> ParsecT Void [Char] Identity [Lexeme CategorySpec 'Matched]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> ParsecT Void [Char] Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
scn

-- | 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.3.0/Documentation.md#basic-rule-syntax>.
parseRule :: String -> Either (ParseErrorBundle String Void) (Rule CategorySpec)
parseRule :: [Char] -> Either (ParseErrorBundle [Char] Void) (Rule CategorySpec)
parseRule = Parser (Rule CategorySpec)
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] Void) (Rule CategorySpec)
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parser ()
scn Parser ()
-> Parser (Rule CategorySpec) -> Parser (Rule CategorySpec)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Rule CategorySpec)
ruleParser Parser (Rule CategorySpec)
-> Parser () -> Parser (Rule CategorySpec)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
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 = Parsec Void [Char] (SoundChanges CategorySpec Directive)
-> [Char]
-> [Char]
-> Either
     (ParseErrorBundle [Char] Void)
     (SoundChanges CategorySpec Directive)
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parser ()
scn Parser ()
-> Parsec Void [Char] (SoundChanges CategorySpec Directive)
-> Parsec Void [Char] (SoundChanges CategorySpec Directive)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void [Char] (SoundChanges CategorySpec Directive)
parser Parsec Void [Char] (SoundChanges CategorySpec Directive)
-> Parser ()
-> Parsec Void [Char] (SoundChanges CategorySpec Directive)
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
""
  where
    parser :: Parsec Void [Char] (SoundChanges CategorySpec Directive)
parser = ParsecT Void [Char] Identity (Statement CategorySpec Directive)
-> Parsec Void [Char] (SoundChanges CategorySpec Directive)
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void [Char] Identity (Statement CategorySpec Directive)
 -> Parsec Void [Char] (SoundChanges CategorySpec Directive))
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
-> Parsec Void [Char] (SoundChanges CategorySpec Directive)
forall a b. (a -> b) -> a -> b
$
        Directive -> Statement CategorySpec Directive
forall (c :: LexemeType -> *) decl. decl -> Statement c decl
DirectiveS (Directive -> Statement CategorySpec Directive)
-> Parser Directive
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Directive
parseDirective
        ParsecT Void [Char] Identity (Statement CategorySpec Directive)
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Filter CategorySpec -> Statement CategorySpec Directive
forall (c :: LexemeType -> *) decl. Filter c -> Statement c decl
FilterS (Filter CategorySpec -> Statement CategorySpec Directive)
-> Parser (Filter CategorySpec)
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Filter CategorySpec)
filterParser
        ParsecT Void [Char] Identity (Statement CategorySpec Directive)
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Rule CategorySpec -> Statement CategorySpec Directive
forall (c :: LexemeType -> *) decl. Rule c -> Statement c decl
RuleS (Rule CategorySpec -> Statement CategorySpec Directive)
-> Parser (Rule CategorySpec)
-> ParsecT Void [Char] Identity (Statement CategorySpec Directive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Rule CategorySpec)
ruleParser