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

module Parsers where
import           Common               (Focuser (..), Mapping, Parser,
                                       Range (..), composeFocusers, focusTo,
                                       foldFocusers, foldMappings, integer,
                                       lexeme, mappingTo, rational,
                                       showRational, 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,
                                       focusCompEq, focusCompOrd, focusConst,
                                       focusContains, focusEach, focusEl,
                                       focusEndsWith, focusFilter, focusId,
                                       focusIf, focusIndex, focusIsAlpha,
                                       focusIsAlphaNum, focusIsDigit,
                                       focusIsLower, focusIsNumber,
                                       focusIsSpace, focusIsUpper, focusKV,
                                       focusKey, focusLength, focusLines,
                                       focusLogic2, focusLogicMany, focusMaxBy,
                                       focusMaxLexBy, focusMinBy, focusMinLexBy,
                                       focusNot, 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
    , 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
    , Text -> Parser Text
symbol Text
"isNumber" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusIsNumber
    , 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
    , Parser Focuser
parseFocusAll
    , Parser Focuser
parseFocusAny
    , Text -> Parser Text
symbol Text
"not" Parser Text -> Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Focuser
focusNot
    , Parser Focuser
parseFocusOr
    , Parser Focuser
parseFocusAnd
    , Parser Focuser
parseFocusEq
    , Parser Focuser
parseFocusNeq
    , Parser Focuser
parseFocusLeq
    , Parser Focuser
parseFocusGeq
    , Parser Focuser -> Parser Focuser
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 Focuser
parseFocusLt Parser Focuser -> Parser Focuser -> Parser Focuser
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 Focuser
parseFocusCollect
    , Parser Focuser
parseFocusGt
    , Parser Focuser
parseFocusLit
    ]

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 -> Focuser
focusCollect (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

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)
    Focuser -> Focuser
focusIf (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

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)
    Focuser -> Focuser
focusFilter (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

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

parseFocusAll :: Parser Focuser
parseFocusAll :: Parser Focuser
parseFocusAll = 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
"all" 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)
    ([Bool] -> Bool) -> Focuser -> Focuser
focusLogicMany [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusAny :: Parser Focuser
parseFocusAny :: Parser Focuser
parseFocusAny = 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
"any" 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)
    ([Bool] -> Bool) -> Focuser -> Focuser
focusLogicMany [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Focuser -> Focuser) -> Parser Focuser -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Focuser
parseFocuser

parseFocusAnd :: Parser Focuser
parseFocusAnd :: Parser Focuser
parseFocusAnd = do
    Text -> Parser Text
symbol Text
"&&"
    Focuser
p1 <- Parser Focuser
parseFocuser
    Focuser
p2 <- Parser Focuser
parseFocuser
    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
$ (Bool -> Bool -> Bool) -> Focuser -> Focuser -> Focuser
focusLogic2 Bool -> Bool -> Bool
(&&) Focuser
p1 Focuser
p2

parseFocusOr :: Parser Focuser
parseFocusOr :: Parser Focuser
parseFocusOr = do
    Text -> Parser Text
symbol Text
"||"
    Focuser
p1 <- Parser Focuser
parseFocuser
    Focuser
p2 <- Parser Focuser
parseFocuser
    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
$ (Bool -> Bool -> Bool) -> Focuser -> Focuser -> Focuser
focusLogic2 Bool -> Bool -> Bool
(||) Focuser
p1 Focuser
p2

parseFocusEq :: Parser Focuser
parseFocusEq :: Parser Focuser
parseFocusEq = do
    Text -> Parser Text
symbol Text
"="
    Focuser
p1 <- Parser Focuser
parseFocuser
    Maybe Focuser
mp2 <- Parser Focuser -> ParsecT Void Text Identity (Maybe Focuser)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Focuser
parseFocuser
    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
$ case Maybe Focuser
mp2 of
        Just Focuser
p2 -> (forall a. Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Focuser
p1 Focuser
p2
        Maybe Focuser
Nothing -> (forall a. Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Focuser
focusId Focuser
p1

parseFocusNeq :: Parser Focuser
parseFocusNeq :: Parser Focuser
parseFocusNeq = do
    Text -> Parser Text
symbol Text
"!="
    Focuser
p1 <- Parser Focuser
parseFocuser
    Maybe Focuser
mp2 <- Parser Focuser -> ParsecT Void Text Identity (Maybe Focuser)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Focuser
parseFocuser
    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
$ case Maybe Focuser
mp2 of
        Just Focuser
p2 -> (forall a. Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Focuser
p1 Focuser
p2
        Maybe Focuser
Nothing -> (forall a. Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Focuser
focusId Focuser
p1

parseFocusLt :: Parser Focuser
parseFocusLt :: Parser Focuser
parseFocusLt = do
    Text -> Parser Text
symbol Text
"<"
    Focuser
p1 <- Parser Focuser
parseFocuser
    Maybe Focuser
mp2 <- Parser Focuser -> ParsecT Void Text Identity (Maybe Focuser)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Focuser
parseFocuser
    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
$ case Maybe Focuser
mp2 of
        Just Focuser
p2 -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(<) Focuser
p1 Focuser
p2
        Maybe Focuser
Nothing -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(<) Focuser
focusId Focuser
p1

parseFocusGt :: Parser Focuser
parseFocusGt :: Parser Focuser
parseFocusGt = do
    Text -> Parser Text
symbol Text
">"
    Focuser
p1 <- Parser Focuser
parseFocuser
    Maybe Focuser
mp2 <- Parser Focuser -> ParsecT Void Text Identity (Maybe Focuser)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Focuser
parseFocuser
    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
$ case Maybe Focuser
mp2 of
        Just Focuser
p2 -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(>) Focuser
p1 Focuser
p2
        Maybe Focuser
Nothing -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(>) Focuser
focusId Focuser
p1

parseFocusLeq :: Parser Focuser
parseFocusLeq :: Parser Focuser
parseFocusLeq = do
    Text -> Parser Text
symbol Text
"<="
    Focuser
p1 <- Parser Focuser
parseFocuser
    Maybe Focuser
mp2 <- Parser Focuser -> ParsecT Void Text Identity (Maybe Focuser)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Focuser
parseFocuser
    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
$ case Maybe Focuser
mp2 of
        Just Focuser
p2 -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(<=) Focuser
p1 Focuser
p2
        Maybe Focuser
Nothing -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(<=) Focuser
focusId Focuser
p1

parseFocusGeq :: Parser Focuser
parseFocusGeq :: Parser Focuser
parseFocusGeq = do
    Text -> Parser Text
symbol Text
">="
    Focuser
p1 <- Parser Focuser
parseFocuser
    Maybe Focuser
mp2 <- Parser Focuser -> ParsecT Void Text Identity (Maybe Focuser)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Focuser
parseFocuser
    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
$ case Maybe Focuser
mp2 of
        Just Focuser
p2 -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(>=) Focuser
p1 Focuser
p2
        Maybe Focuser
Nothing -> (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
(>=) Focuser
focusId Focuser
p1

parseFocusLit :: Parser Focuser
parseFocusLit :: Parser Focuser
parseFocusLit = Parser Focuser
parseFocusString Parser Focuser -> Parser Focuser -> Parser Focuser
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 Focuser
parseFocusNumber
  where
    parseFocusString :: Parser Focuser
parseFocusString = Text -> Focuser
focusConst (Text -> Focuser) -> Parser Text -> Parser Focuser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringLiteral
    parseFocusNumber :: Parser Focuser
parseFocusNumber = Text -> Focuser
focusConst (Text -> Focuser) -> (Rational -> Text) -> Rational -> Focuser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Text
showRational (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

-- 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

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
-> Parser Text
-> 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
'"') (Text -> Parser Text
symbol 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)
    Focuser -> Mapping
mappingAppend (Focuser -> Mapping)
-> ([Focuser] -> Focuser) -> [Focuser] -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focuser] -> Focuser
foldFocusers ([Focuser] -> Mapping)
-> ParsecT Void Text Identity [Focuser]
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Focuser]
parseFocusers

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)
    Focuser -> Mapping
mappingPrepend (Focuser -> Mapping)
-> ([Focuser] -> Focuser) -> [Focuser] -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focuser] -> Focuser
foldFocusers ([Focuser] -> Mapping)
-> ParsecT Void Text Identity [Focuser]
-> ParsecT Void Text Identity Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Focuser]
parseFocusers

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