{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# LANGUAGE OverloadedStrings #-}

module Parsers where
import           Common               (Comparison (..), Evaluatable (..),
                                       Focuser (..), IfExpr (..), Mapping,
                                       Oper (..), Parser, Quantor (..),
                                       Range (..), composeFocusers, focusTo,
                                       foldFocusers, foldMappings, integer,
                                       lexeme, mappingTo, rational, symbol)
import           Data.Char            (isAlphaNum)
import           Data.Functor         (($>))
import           Data.Maybe           (fromMaybe)
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Focusers             (escaping, focusAtIdx, focusAtKey,
                                       focusAverage, focusCollect, focusCols,
                                       focusContains, focusEach, focusEl,
                                       focusEndsWith, focusFilter, focusId,
                                       focusIf, focusIndex, focusIsAlpha,
                                       focusIsAlphaNum, focusIsDigit,
                                       focusIsLower, focusIsSpace, focusIsUpper,
                                       focusKV, focusKey, focusLength,
                                       focusLines, focusMaxBy, focusMaxLexBy,
                                       focusMinBy, focusMinLexBy, focusProduct,
                                       focusRegex, focusSlice, focusSortedBy,
                                       focusSortedLexBy, focusSpace,
                                       focusStartsWith, focusSum, focusVal,
                                       focusWords)
import           Mappings             (mappingAbs, mappingAdd, mappingAppend,
                                       mappingDiv, mappingId, mappingLength,
                                       mappingLower, mappingMap, mappingMult,
                                       mappingPow, mappingPrepend,
                                       mappingReverse, mappingSign,
                                       mappingSlice, mappingSortBy,
                                       mappingSortLexBy, mappingSub,
                                       mappingUpper)
import           Text.Megaparsec      (MonadParsec (try), anySingle,
                                       anySingleBut, between, choice, empty,
                                       label, many, noneOf, notFollowedBy,
                                       optional, satisfy, sepBy, sepBy1,
                                       takeWhile1P, (<|>))
import           Text.Megaparsec.Char (char, string)

-- Focuser parsers

parseFocuser :: Parser Focuser
parseFocuser :: Parser Focuser
parseFocuser = String -> Parser Focuser -> Parser Focuser
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"valid focuser" (Parser Focuser -> Parser Focuser)
-> Parser Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ [Parser Focuser] -> Parser Focuser
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parser Text
symbol Text
"id" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusId
    , Text -> Parser Text
symbol Text
"each" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusEach
    , Parser Focuser
parseFocusCollect
    , Text -> Parser Text
symbol Text
"words" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusWords
    , Text -> Parser Text
symbol Text
"lines" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusLines
    , Text -> Parser Text
symbol Text
"ws" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusSpace
    , Text -> Parser Text
symbol Text
"cols" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusCols
    , Parser Focuser
parseFocusSlice
    , Parser Focuser
parseFocusSortedLexBy
    , Text -> Parser Text
symbol Text
"sortedLex" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Focuser
focusSortedLexBy Focuser
focusId
    , Parser Focuser
parseFocusMinLexBy
    , Parser Focuser
parseFocusMaxLexBy
    , Text -> Parser Text
symbol Text
"minLex" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Focuser
focusMinLexBy Focuser
focusId
    , Text -> Parser Text
symbol Text
"maxLex" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Focuser
focusMaxLexBy Focuser
focusId
    , Parser Focuser
parseFocusSortedBy
    , Parser Focuser
parseFocusIndex
    , Text -> Parser Text
symbol Text
"sorted" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Focuser
focusSortedBy Focuser
focusId
    , Parser Focuser
parseFocusTo
    , Text -> Parser Text
symbol Text
"len" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusLength
    , Parser Focuser
parseFocusMinBy
    , Parser Focuser
parseFocusMaxBy
    , Text -> Parser Text
symbol Text
"min" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Focuser
focusMinBy Focuser
focusId
    , Text -> Parser Text
symbol Text
"max" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Focuser
focusMaxBy Focuser
focusId
    , Parser Text -> Parser Text -> Parser Focuser -> Parser Focuser
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Text -> Parser Text
symbol Text
")") (Parser Focuser -> Parser Focuser)
-> Parser Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ [Focuser] -> Focuser
foldFocusers ([Focuser] -> Focuser)
-> ParsecT Void Text Identity [Focuser] -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Focuser]
parseFocusers
    , Text -> Parser Text
symbol Text
"sum" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusSum
    , Text -> Parser Text
symbol Text
"product" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusProduct
    , Parser Focuser
parseFocusAverage
    , Parser Focuser
parseFocusAdd
    , Parser Focuser
parseFocusSub
    , Parser Focuser
parseFocusMult
    , Parser Focuser
parseFocusDiv
    , Parser Focuser
parseFocusPow
    , Text -> Parser Text
symbol Text
"abs" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping -> Focuser
focusTo Mapping
mappingAbs
    , Text -> Parser Text
symbol Text
"sign" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping -> Focuser
focusTo Mapping
mappingSign
    , Parser Focuser
parseFocusIf
    , Text -> Parser Text
symbol Text
"isUpper" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsUpper
    , Text -> Parser Text
symbol Text
"isLower" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsLower
    , Text -> Parser Text
symbol Text
"isDigit" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsDigit
    , Text -> Parser Text
symbol Text
"isAlphaNum" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsAlphaNum
    , Text -> Parser Text
symbol Text
"isAlpha" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsAlpha
    , Text -> Parser Text
symbol Text
"isSpace" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsSpace
    , Parser Focuser
parseFocusRegex
    , Parser Focuser
parseFocusFilter
    , Parser Focuser
parseFocusContains
    , Parser Focuser
parseFocusStartsWith
    , Parser Focuser
parseFocusEndsWith
    , Text -> Parser Text
symbol Text
"el" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusEl
    , Text -> Parser Text
symbol Text
"kv" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusKV
    , Text -> Parser Text
symbol Text
"key" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusKey
    , Text -> Parser Text
symbol Text
"val" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusVal
    , Parser Focuser
parseFocusAtKey
    , Parser Focuser
parseFocusAtIdx
    ]

parseFocusers :: Parser [Focuser]
parseFocusers :: ParsecT Void Text Identity [Focuser]
parseFocusers = String
-> ParsecT Void Text Identity [Focuser]
-> ParsecT Void Text Identity [Focuser]
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"valid focuser stack" (ParsecT Void Text Identity [Focuser]
 -> ParsecT Void Text Identity [Focuser])
-> ParsecT Void Text Identity [Focuser]
-> ParsecT Void Text Identity [Focuser]
forall a b. (a -> b) -> a -> b
$ Parser Focuser
parseFocuser Parser Focuser
-> Parser Text -> ParsecT Void Text Identity [Focuser]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Text -> Parser Text
symbol Text
"."

parseFocusCollect :: Parser Focuser
parseFocusCollect :: Parser Focuser
parseFocusCollect = do
    Text -> Parser Text
symbol Text
"<"
    [Focuser]
focusers <- ParsecT Void Text Identity [Focuser]
parseFocusers
    Text -> Parser Text
symbol Text
">"
    let focuser :: Focuser
focuser = [Focuser] -> Focuser
foldFocusers [Focuser]
focusers
    Focuser -> Parser Focuser
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Focuser -> Parser Focuser) -> Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ Focuser -> Focuser
focusCollect Focuser
focuser

parseFocusSlice :: Parser Focuser
parseFocusSlice :: Parser Focuser
parseFocusSlice = do
    [Range]
ranges <- Parser Text
-> Parser Text
-> ParsecT Void Text Identity [Range]
-> ParsecT Void Text Identity [Range]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"{") (Text -> Parser Text
symbol Text
"}") (Parser Range
range Parser Range -> Parser Text -> ParsecT Void Text Identity [Range]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Text -> Parser Text
symbol Text
",")
    Focuser -> Parser Focuser
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Focuser -> Parser Focuser) -> Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ [Range] -> Focuser
focusSlice [Range]
ranges

range :: Parser Range
range :: Parser Range
range = Parser Range -> Parser Range
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Range
rangeRange Parser Range -> Parser Range -> Parser Range
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Range
rangeSingle

rangeSingle :: Parser Range
rangeSingle :: Parser Range
rangeSingle = Int -> Range
RangeSingle (Int -> Range) -> ParsecT Void Text Identity Int -> Parser Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
integer

rangeRange :: Parser Range
rangeRange :: Parser Range
rangeRange = String -> Parser Range -> Parser Range
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"range" (Parser Range -> Parser Range) -> Parser Range -> Parser Range
forall a b. (a -> b) -> a -> b
$ do
    Maybe Int
mstart <- ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Int
integer
    Text -> Parser Text
symbol Text
":"
    Maybe Int
mend <- ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Int
integer
    Range -> Parser Range
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> Parser Range) -> Range -> Parser Range
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Range
RangeRange Maybe Int
mstart Maybe Int
mend

parseFocusSortedBy :: Parser Focuser
parseFocusSortedBy :: Parser Focuser
parseFocusSortedBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"sortedBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Focuser
focusSortedBy (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusIndex :: Parser Focuser
parseFocusIndex :: Parser Focuser
parseFocusIndex = do
    Text -> Parser Text
symbol Text
"["
    Int
n <- ParsecT Void Text Identity Int
integer
    Text -> Parser Text
symbol Text
"]"
    Focuser -> Parser Focuser
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Focuser -> Parser Focuser) -> Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ Int -> Focuser
focusIndex Int
n

parseFocusTo :: Parser Focuser
parseFocusTo :: Parser Focuser
parseFocusTo = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"to" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Mapping
mapping <- [Mapping] -> Mapping
foldMappings ([Mapping] -> Mapping)
-> ParsecT Void Text Identity [Mapping]
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Mapping]
parseMappings
    Focuser -> Parser Focuser
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Focuser -> Parser Focuser) -> Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ Mapping -> Focuser
focusTo Mapping
mapping

parseFocusMinBy :: Parser Focuser
parseFocusMinBy :: Parser Focuser
parseFocusMinBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"minBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Focuser
focusMinBy (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusMaxBy :: Parser Focuser
parseFocusMaxBy :: Parser Focuser
parseFocusMaxBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"maxBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Focuser
focusMaxBy (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusSortedLexBy :: Parser Focuser
parseFocusSortedLexBy :: Parser Focuser
parseFocusSortedLexBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"sortedLexBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Focuser
focusSortedLexBy (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusMinLexBy :: Parser Focuser
parseFocusMinLexBy :: Parser Focuser
parseFocusMinLexBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"minLexBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Focuser
focusMinLexBy (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusMaxLexBy :: Parser Focuser
parseFocusMaxLexBy :: Parser Focuser
parseFocusMaxLexBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"maxLexBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Focuser
focusMaxLexBy (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusAdd :: Parser Focuser
parseFocusAdd :: Parser Focuser
parseFocusAdd = do
    Text -> Parser Text
symbol Text
"add "
    Mapping -> Focuser
focusTo (Mapping -> Focuser)
-> (Rational -> Mapping) -> Rational -> Focuser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Mapping
mappingAdd (Rational -> Focuser)
-> ParsecT Void Text Identity Rational -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseFocusSub :: Parser Focuser
parseFocusSub :: Parser Focuser
parseFocusSub = do
    Text -> Parser Text
symbol Text
"sub "
    Mapping -> Focuser
focusTo (Mapping -> Focuser)
-> (Rational -> Mapping) -> Rational -> Focuser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Mapping
mappingSub (Rational -> Focuser)
-> ParsecT Void Text Identity Rational -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseFocusMult :: Parser Focuser
parseFocusMult :: Parser Focuser
parseFocusMult = do
    Text -> Parser Text
symbol Text
"mult "
    Mapping -> Focuser
focusTo (Mapping -> Focuser)
-> (Rational -> Mapping) -> Rational -> Focuser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Mapping
mappingMult (Rational -> Focuser)
-> ParsecT Void Text Identity Rational -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseFocusDiv :: Parser Focuser
parseFocusDiv :: Parser Focuser
parseFocusDiv = do
    Text -> Parser Text
symbol Text
"div "
    Mapping -> Focuser
focusTo (Mapping -> Focuser)
-> (Rational -> Mapping) -> Rational -> Focuser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Mapping
mappingDiv (Rational -> Focuser)
-> ParsecT Void Text Identity Rational -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseFocusPow :: Parser Focuser
parseFocusPow :: Parser Focuser
parseFocusPow = do
    Text -> Parser Text
symbol Text
"pow "
    Mapping -> Focuser
focusTo (Mapping -> Focuser) -> (Int -> Mapping) -> Int -> Focuser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Mapping
mappingPow (Int -> Focuser)
-> ParsecT Void Text Identity Int -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
integer

parseFocusIf :: Parser Focuser
parseFocusIf :: Parser Focuser
parseFocusIf = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"if" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    IfExpr -> Focuser
focusIf (IfExpr -> Focuser)
-> ParsecT Void Text Identity IfExpr -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity IfExpr
parseIfExpr

parseIfExpr :: Parser IfExpr
parseIfExpr :: ParsecT Void Text Identity IfExpr
parseIfExpr = String
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"one or more blocks separated by '||'" (ParsecT Void Text Identity IfExpr
 -> ParsecT Void Text Identity IfExpr)
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a b. (a -> b) -> a -> b
$ do
    [IfExpr]
andBlocks <- ParsecT Void Text Identity IfExpr
parseAndBlock ParsecT Void Text Identity IfExpr
-> Parser Text -> ParsecT Void Text Identity [IfExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Text -> Parser Text
symbol Text
"||"
    case [IfExpr]
andBlocks of
        []      -> ParsecT Void Text Identity IfExpr
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty
        [IfExpr
block] -> IfExpr -> ParsecT Void Text Identity IfExpr
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return IfExpr
block
        [IfExpr]
_       -> IfExpr -> ParsecT Void Text Identity IfExpr
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfExpr -> ParsecT Void Text Identity IfExpr)
-> IfExpr -> ParsecT Void Text Identity IfExpr
forall a b. (a -> b) -> a -> b
$ [IfExpr] -> IfExpr
IfOr [IfExpr]
andBlocks

parseAndBlock :: Parser IfExpr
parseAndBlock :: ParsecT Void Text Identity IfExpr
parseAndBlock = String
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"one or more blocks separated by '&&'" (ParsecT Void Text Identity IfExpr
 -> ParsecT Void Text Identity IfExpr)
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a b. (a -> b) -> a -> b
$ do
    [IfExpr]
atoms <- ParsecT Void Text Identity IfExpr
parseAtom ParsecT Void Text Identity IfExpr
-> Parser Text -> ParsecT Void Text Identity [IfExpr]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Text -> Parser Text
symbol Text
"&&"
    case [IfExpr]
atoms of
        []     -> ParsecT Void Text Identity IfExpr
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty
        [IfExpr
atom] -> IfExpr -> ParsecT Void Text Identity IfExpr
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return IfExpr
atom
        [IfExpr]
_      -> IfExpr -> ParsecT Void Text Identity IfExpr
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfExpr -> ParsecT Void Text Identity IfExpr)
-> IfExpr -> ParsecT Void Text Identity IfExpr
forall a b. (a -> b) -> a -> b
$ [IfExpr] -> IfExpr
IfAnd [IfExpr]
atoms

parseAtom :: Parser IfExpr
parseAtom :: ParsecT Void Text Identity IfExpr
parseAtom = Parser Text
-> Parser Text
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Text -> Parser Text
symbol Text
")") ParsecT Void Text Identity IfExpr
parseIfExpr ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity IfExpr
parseComp ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
-> ParsecT Void Text Identity IfExpr
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity IfExpr
parseIfExprShort

parseComp :: Parser IfExpr
parseComp :: ParsecT Void Text Identity IfExpr
parseComp = do
    Quantor
q1 <- Quantor -> Maybe Quantor -> Quantor
forall a. a -> Maybe a -> a
fromMaybe Quantor
QAll (Maybe Quantor -> Quantor)
-> ParsecT Void Text Identity (Maybe Quantor)
-> ParsecT Void Text Identity Quantor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Quantor
-> ParsecT Void Text Identity (Maybe Quantor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Quantor
parseQuantor
    Evaluatable
lhs <- Evaluatable -> Maybe Evaluatable -> Evaluatable
forall a. a -> Maybe a -> a
fromMaybe (Focuser -> Evaluatable
EFocuser Focuser
focusId) (Maybe Evaluatable -> Evaluatable)
-> ParsecT Void Text Identity (Maybe Evaluatable)
-> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity (Maybe Evaluatable)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Evaluatable
parseEvaluatableLong
    Oper
comp <- Parser Oper
parseCompOp
    Quantor
q2 <- Quantor -> Maybe Quantor -> Quantor
forall a. a -> Maybe a -> a
fromMaybe Quantor
QAll (Maybe Quantor -> Quantor)
-> ParsecT Void Text Identity (Maybe Quantor)
-> ParsecT Void Text Identity Quantor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Quantor
-> ParsecT Void Text Identity (Maybe Quantor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Quantor
parseQuantor
    Evaluatable
rhs <- ParsecT Void Text Identity Evaluatable
parseEvaluatableLong
    IfExpr -> ParsecT Void Text Identity IfExpr
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfExpr -> ParsecT Void Text Identity IfExpr)
-> IfExpr -> ParsecT Void Text Identity IfExpr
forall a b. (a -> b) -> a -> b
$ Comparison -> IfExpr
IfSingle (Comparison -> IfExpr) -> Comparison -> IfExpr
forall a b. (a -> b) -> a -> b
$ (Quantor, Evaluatable)
-> Oper -> (Quantor, Evaluatable) -> Comparison
Comparison (Quantor
q1, Evaluatable
lhs) Oper
comp (Quantor
q2, Evaluatable
rhs)

parseQuantor :: Parser Quantor
parseQuantor :: ParsecT Void Text Identity Quantor
parseQuantor = Text -> Parser Text
symbol Text
"all " Parser Text -> Quantor -> ParsecT Void Text Identity Quantor
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Quantor
QAll ParsecT Void Text Identity Quantor
-> ParsecT Void Text Identity Quantor
-> ParsecT Void Text Identity Quantor
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
symbol Text
"any " Parser Text -> Quantor -> ParsecT Void Text Identity Quantor
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Quantor
QAny

parseCompOp :: Parser Oper
parseCompOp :: Parser Oper
parseCompOp = [Parser Oper] -> Parser Oper
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parser Text
symbol Text
"=" Parser Text -> Oper -> Parser Oper
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Oper
OpEq
    , Text -> Parser Text
symbol Text
"!=" Parser Text -> Oper -> Parser Oper
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Oper
OpNe
    , Text -> Parser Text
symbol Text
"<=" Parser Text -> Oper -> Parser Oper
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Oper
OpLe
    , Text -> Parser Text
symbol Text
"<"  Parser Text -> Oper -> Parser Oper
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Oper
OpLt
    , Text -> Parser Text
symbol Text
">=" Parser Text -> Oper -> Parser Oper
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Oper
OpGe
    , Text -> Parser Text
symbol Text
">"  Parser Text -> Oper -> Parser Oper
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Oper
OpGt
    ]

parseIfExprShort :: Parser IfExpr
parseIfExprShort :: ParsecT Void Text Identity IfExpr
parseIfExprShort = do
    Quantor
q <- Quantor -> Maybe Quantor -> Quantor
forall a. a -> Maybe a -> a
fromMaybe Quantor
QAll (Maybe Quantor -> Quantor)
-> ParsecT Void Text Identity (Maybe Quantor)
-> ParsecT Void Text Identity Quantor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Quantor
-> ParsecT Void Text Identity (Maybe Quantor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Quantor
parseQuantor
    Evaluatable
e <- Focuser -> Evaluatable
EFocuser (Focuser -> Evaluatable)
-> Parser Focuser -> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser
    IfExpr -> ParsecT Void Text Identity IfExpr
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfExpr -> ParsecT Void Text Identity IfExpr)
-> IfExpr -> ParsecT Void Text Identity IfExpr
forall a b. (a -> b) -> a -> b
$ Comparison -> IfExpr
IfSingle (Comparison -> IfExpr) -> Comparison -> IfExpr
forall a b. (a -> b) -> a -> b
$ (Quantor, Evaluatable)
-> Oper -> (Quantor, Evaluatable) -> Comparison
Comparison (Quantor
q, Evaluatable
e) Oper
OpEq (Quantor
QAny, Text -> Evaluatable
EText Text
"1")

parseFocusRegex :: Parser Focuser
parseFocusRegex :: Parser Focuser
parseFocusRegex = do
    Text -> Parser Text
symbol Text
"regex"
    Text -> Focuser
focusRegex (Text -> Focuser) -> Parser Text -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral

parseFocusFilter :: Parser Focuser
parseFocusFilter :: Parser Focuser
parseFocusFilter = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"filter" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    IfExpr -> Focuser
focusFilter (IfExpr -> Focuser)
-> ParsecT Void Text Identity IfExpr -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity IfExpr
parseIfExpr

parseFocusContains :: Parser Focuser
parseFocusContains :: Parser Focuser
parseFocusContains = do
    Text -> Parser Text
symbol Text
"contains"
    Text -> Focuser
focusContains (Text -> Focuser) -> Parser Text -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral

parseFocusStartsWith :: Parser Focuser
parseFocusStartsWith :: Parser Focuser
parseFocusStartsWith = do
    Text -> Parser Text
symbol Text
"startsWith"
    Text -> Focuser
focusStartsWith (Text -> Focuser) -> Parser Text -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral

parseFocusEndsWith :: Parser Focuser
parseFocusEndsWith :: Parser Focuser
parseFocusEndsWith = do
    Text -> Parser Text
symbol Text
"endsWith"
    Text -> Focuser
focusEndsWith (Text -> Focuser) -> Parser Text -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral

parseFocusAverage :: Parser Focuser
parseFocusAverage :: Parser Focuser
parseFocusAverage = do
    Text -> Parser Text
symbol Text
"average"
    Rational
def <- Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
0 (Maybe Rational -> Rational)
-> ParsecT Void Text Identity (Maybe Rational)
-> ParsecT Void Text Identity Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Rational
rational
    Focuser -> Parser Focuser
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Focuser -> Parser Focuser) -> Focuser -> Parser Focuser
forall a b. (a -> b) -> a -> b
$ Rational -> Focuser
focusAverage Rational
def

parseFocusAtKey :: Parser Focuser
parseFocusAtKey :: Parser Focuser
parseFocusAtKey = do
    Text -> Parser Text
symbol Text
"atKey"
    Text -> Focuser
focusAtKey (Text -> Focuser) -> Parser Text -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral

parseFocusAtIdx :: Parser Focuser
parseFocusAtIdx :: Parser Focuser
parseFocusAtIdx = do
    Text -> Parser Text
symbol Text
"atIdx "
    Int -> Focuser
focusAtIdx (Int -> Focuser)
-> ParsecT Void Text Identity Int -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
integer

-- mapping parsers

parseMapping :: Parser Mapping
parseMapping :: ParsecT Void Text Identity Mapping
parseMapping = String
-> ParsecT Void Text Identity Mapping
-> ParsecT Void Text Identity Mapping
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"valid mapping" (ParsecT Void Text Identity Mapping
 -> ParsecT Void Text Identity Mapping)
-> ParsecT Void Text Identity Mapping
-> ParsecT Void Text Identity Mapping
forall a b. (a -> b) -> a -> b
$ [ParsecT Void Text Identity Mapping]
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Text -> Parser Text
symbol Text
"reverse" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingReverse
    , Text -> Parser Text
symbol Text
"len" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingLength
    , ParsecT Void Text Identity Mapping
parseMappingMap
    , ParsecT Void Text Identity Mapping
parseMappingAppend
    , ParsecT Void Text Identity Mapping
parseMappingPrepend
    , Text -> Parser Text
symbol Text
"upper" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingUpper
    , Text -> Parser Text
symbol Text
"lower" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingLower
    , Parser Text
-> Parser Text
-> ParsecT Void Text Identity Mapping
-> ParsecT Void Text Identity Mapping
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Text -> Parser Text
symbol Text
")") (ParsecT Void Text Identity Mapping
 -> ParsecT Void Text Identity Mapping)
-> ParsecT Void Text Identity Mapping
-> ParsecT Void Text Identity Mapping
forall a b. (a -> b) -> a -> b
$ [Mapping] -> Mapping
foldMappings ([Mapping] -> Mapping)
-> ParsecT Void Text Identity [Mapping]
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Mapping]
parseMappings
    , ParsecT Void Text Identity Mapping
parseMappingAdd
    , ParsecT Void Text Identity Mapping
parseMappingSub
    , ParsecT Void Text Identity Mapping
parseMappingMult
    , ParsecT Void Text Identity Mapping
parseMappingDiv
    , ParsecT Void Text Identity Mapping
parseMappingPow
    , Text -> Parser Text
symbol Text
"abs" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingAbs
    , Text -> Parser Text
symbol Text
"sign" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingSign
    , ParsecT Void Text Identity Mapping
parseMappingSlice
    , ParsecT Void Text Identity Mapping
parseMappingSortLexBy
    , Text -> Parser Text
symbol Text
"sortLex" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Mapping
mappingSortLexBy Focuser
focusId
    , ParsecT Void Text Identity Mapping
parseMappingSortBy
    , Text -> Parser Text
symbol Text
"sort" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser -> Mapping
mappingSortBy Focuser
focusId
    , Text -> Parser Text
symbol Text
"id" Parser Text -> Mapping -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Mapping
mappingId
    , ParsecT Void Text Identity Mapping
parseMappingTo
    ]

parseMappings :: Parser [Mapping]
parseMappings :: ParsecT Void Text Identity [Mapping]
parseMappings = String
-> ParsecT Void Text Identity [Mapping]
-> ParsecT Void Text Identity [Mapping]
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"valid mapping stack" (ParsecT Void Text Identity [Mapping]
 -> ParsecT Void Text Identity [Mapping])
-> ParsecT Void Text Identity [Mapping]
-> ParsecT Void Text Identity [Mapping]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Mapping
parseMapping ParsecT Void Text Identity Mapping
-> Parser Text -> ParsecT Void Text Identity [Mapping]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Text -> Parser Text
symbol Text
":"

parseMappingMap :: Parser Mapping
parseMappingMap :: ParsecT Void Text Identity Mapping
parseMappingMap = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"map" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Mapping -> Mapping
mappingMap (Mapping -> Mapping)
-> ParsecT Void Text Identity Mapping
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Mapping
parseMapping

parseEvaluatable :: Parser Evaluatable
parseEvaluatable :: ParsecT Void Text Identity Evaluatable
parseEvaluatable =
    Text -> Evaluatable
EText (Text -> Evaluatable)
-> Parser Text -> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Rational -> Evaluatable
ENumber (Rational -> Evaluatable)
-> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Focuser -> Evaluatable
EFocuser (Focuser -> Evaluatable)
-> Parser Focuser -> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseEvaluatableLong :: Parser Evaluatable
parseEvaluatableLong :: ParsecT Void Text Identity Evaluatable
parseEvaluatableLong =
    Text -> Evaluatable
EText (Text -> Evaluatable)
-> Parser Text -> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Rational -> Evaluatable
ENumber (Rational -> Evaluatable)
-> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Evaluatable
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Focuser -> Evaluatable
EFocuser (Focuser -> Evaluatable)
-> ([Focuser] -> Focuser) -> [Focuser] -> Evaluatable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focuser] -> Focuser
foldFocusers ([Focuser] -> Evaluatable)
-> ParsecT Void Text Identity [Focuser]
-> ParsecT Void Text Identity Evaluatable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Focuser]
parseFocusers

stringLiteral :: Parser Text
stringLiteral :: Parser Text
stringLiteral = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"string literal" (do
    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
anySingleBut Char
Token Text
'"'
        ])

parseMappingAppend :: Parser Mapping
parseMappingAppend :: ParsecT Void Text Identity Mapping
parseMappingAppend = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"append" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Evaluatable -> Mapping
mappingAppend (Evaluatable -> Mapping)
-> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Evaluatable
parseEvaluatableLong

parseMappingPrepend :: Parser Mapping
parseMappingPrepend :: ParsecT Void Text Identity Mapping
parseMappingPrepend = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"prepend" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Evaluatable -> Mapping
mappingPrepend (Evaluatable -> Mapping)
-> ParsecT Void Text Identity Evaluatable
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Evaluatable
parseEvaluatableLong

parseMappingAdd :: Parser Mapping
parseMappingAdd :: ParsecT Void Text Identity Mapping
parseMappingAdd = do
    Text -> Parser Text
symbol Text
"add "
    Rational -> Mapping
mappingAdd (Rational -> Mapping)
-> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseMappingSub :: Parser Mapping
parseMappingSub :: ParsecT Void Text Identity Mapping
parseMappingSub = do
    Text -> Parser Text
symbol Text
"sub "
    Rational -> Mapping
mappingSub (Rational -> Mapping)
-> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseMappingMult :: Parser Mapping
parseMappingMult :: ParsecT Void Text Identity Mapping
parseMappingMult = do
    Text -> Parser Text
symbol Text
"mult "
    Rational -> Mapping
mappingMult (Rational -> Mapping)
-> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseMappingDiv :: Parser Mapping
parseMappingDiv :: ParsecT Void Text Identity Mapping
parseMappingDiv = do
    Text -> Parser Text
symbol Text
"div "
    Rational -> Mapping
mappingDiv (Rational -> Mapping)
-> ParsecT Void Text Identity Rational
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Rational
rational

parseMappingPow :: Parser Mapping
parseMappingPow :: ParsecT Void Text Identity Mapping
parseMappingPow = do
    Text -> Parser Text
symbol Text
"pow "
    Int -> Mapping
mappingPow (Int -> Mapping)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
integer

parseMappingSlice :: Parser Mapping
parseMappingSlice :: ParsecT Void Text Identity Mapping
parseMappingSlice = do
    [Range]
ranges <- Parser Text
-> Parser Text
-> ParsecT Void Text Identity [Range]
-> ParsecT Void Text Identity [Range]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"{") (Text -> Parser Text
symbol Text
"}") (Parser Range
range Parser Range -> Parser Text -> ParsecT Void Text Identity [Range]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Text -> Parser Text
symbol Text
",")
    Mapping -> ParsecT Void Text Identity Mapping
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mapping -> ParsecT Void Text Identity Mapping)
-> Mapping -> ParsecT Void Text Identity Mapping
forall a b. (a -> b) -> a -> b
$ [Range] -> Mapping
mappingSlice [Range]
ranges

parseMappingSortBy :: Parser Mapping
parseMappingSortBy :: ParsecT Void Text Identity Mapping
parseMappingSortBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"sortBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Mapping
mappingSortBy (Focuser -> Mapping)
-> Parser Focuser -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseMappingSortLexBy :: Parser Mapping
parseMappingSortLexBy :: ParsecT Void Text Identity Mapping
parseMappingSortLexBy = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"sortLexBy" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser -> Mapping
mappingSortLexBy (Focuser -> Mapping)
-> Parser Focuser -> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseMappingTo :: Parser Mapping
parseMappingTo :: ParsecT Void Text Identity Mapping
parseMappingTo = do
    Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"to" ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Token Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
    Focuser
focuser <- [Focuser] -> Focuser
foldFocusers ([Focuser] -> Focuser)
-> ParsecT Void Text Identity [Focuser] -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Focuser]
parseFocusers
    Mapping -> ParsecT Void Text Identity Mapping
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mapping -> ParsecT Void Text Identity Mapping)
-> Mapping -> ParsecT Void Text Identity Mapping
forall a b. (a -> b) -> a -> b
$ Focuser -> Mapping
mappingTo Focuser
focuser