{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}

module Focusers where

import           Common               (Focus (..), Focuser (..), Mapping,
                                       Parser, Range (RangeSingle),
                                       _toListUnsafe, composeFocusers,
                                       fromIndexes, getIndexes, lexeme,
                                       makeFilteredText, mapText,
                                       readMaybeRational, showRational, symbol,
                                       toListUnsafe, toTextUnsafe, unsort, ws)
import           Control.Applicative  ((<|>))
import           Control.Lens         (lens, partsOf, (^..))
import           Control.Monad        (void, when, zipWithM)
import           Data.Char            (isAlpha, isAlphaNum, isDigit, isLower,
                                       isSpace, isUpper)
import           Data.Data.Lens       (biplate)
import           Data.Function        (on)
import           Data.Functor         ((<&>))
import           Data.List            (sortBy, transpose)
import           Data.Maybe           (mapMaybe)
import           Data.Ord             (comparing)
import           Data.Ratio           (denominator)
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Text.Megaparsec      (anySingle, anySingleBut, between, choice,
                                       empty, getOffset, many, optional,
                                       parseMaybe, satisfy, sepBy, some, try)
import           Text.Megaparsec.Char (char)
import           Text.Read            (readMaybe)
import           Text.Regex.PCRE      (AllMatches (getAllMatches), (=~))
import           Text.Regex.PCRE.Text ()

focusId :: Focuser
focusId :: Focuser
focusId = Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
forall a. a -> a
Traversal' Focus Focus
id

focusEach :: Focuser
focusEach :: Focuser
focusEach = Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
traverseFocus

traverseFocus :: Applicative f => (Focus -> f Focus) -> (Focus -> f Focus)
traverseFocus :: Traversal' Focus Focus
traverseFocus Focus -> f Focus
f Focus
focus = case Focus
focus of
    FText Text
str -> Text -> Focus
FText (Text -> Focus) -> ([Focus] -> Text) -> [Focus] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> ([Focus] -> [Text]) -> [Focus] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> Text
toTextUnsafe ([Focus] -> Focus) -> f [Focus] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus) -> [Focus] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Focus -> f Focus
f ((Char -> Focus) -> Text -> [Focus]
forall a. (Char -> a) -> Text -> [a]
mapText (Text -> Focus
FText (Text -> Focus) -> (Char -> Text) -> Char -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) Text
str)
    FList [Focus]
lst -> [Focus] -> Focus
FList ([Focus] -> Focus) -> f [Focus] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus) -> [Focus] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Focus -> f Focus
f [Focus]
lst

focusCollect :: Focuser -> Focuser
focusCollect :: Focuser -> Focuser
focusCollect (FTrav Traversal' Focus Focus
innerTrav) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ Traversing (->) f Focus Focus Focus Focus
-> LensLike f Focus Focus [Focus] [Focus]
forall (f :: * -> *) s t a.
Functor f =>
Traversing (->) f s t a a -> LensLike f s t [a] [a]
partsOf Traversing (->) f Focus Focus Focus Focus
Traversal' Focus Focus
innerTrav LensLike f Focus Focus [Focus] [Focus]
-> ((Focus -> f Focus) -> [Focus] -> f [Focus])
-> (Focus -> f Focus)
-> Focus
-> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Focus -> f Focus) -> [Focus] -> f [Focus]
Lens' [Focus] Focus
_toListUnsafe

focusWords :: Focuser
focusWords :: Focuser
focusWords = Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
wordsTrav

wordsTrav :: Applicative f => (Focus -> f Focus) -> (Focus -> f Focus)
wordsTrav :: Traversal' Focus Focus
wordsTrav Focus -> f Focus
_ flst :: Focus
flst@(FList [Focus]
_) = Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
flst
wordsTrav Focus -> f Focus
f (FText Text
str) =
    let ([Text]
str_ws, [Text]
str_words) = Text -> ([Text], [Text])
myWords Text
str
        new_words :: f [Text]
new_words = (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> Text
toTextUnsafe ([Focus] -> [Text]) -> f [Focus] -> f [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Focus) -> [Text] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText) [Text]
str_words
        new_str :: f Text
new_str = [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
interleave [Text]
str_ws ([Text] -> Text) -> f [Text] -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Text]
new_words
    in  Text -> Focus
FText (Text -> Focus) -> f Text -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_str

myWords :: Text -> ([Text], [Text])
myWords :: Text -> ([Text], [Text])
myWords Text
"" = ([], [])
myWords Text
str =
    let (Text
ws, Text
str') = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isSpace Text
str
        (Text
word, Text
str'') = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace Text
str'
        ([Text]
str_ws, [Text]
str_words) = Text -> ([Text], [Text])
myWords Text
str''
    in  (Text
ws Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
str_ws, if Bool -> Bool
not (Text -> Bool
T.null Text
word) then Text
word Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
str_words else [Text]
str_words)

focusSpace :: Focuser
focusSpace :: Focuser
focusSpace = Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
spaceTrav

spaceTrav :: Applicative f => (Focus -> f Focus) -> (Focus -> f Focus)
spaceTrav :: Traversal' Focus Focus
spaceTrav Focus -> f Focus
_ flst :: Focus
flst@(FList [Focus]
_) = Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
flst
spaceTrav Focus -> f Focus
f (FText Text
str) =
    let ([Text]
str_nonspace, [Text]
str_space) = Text -> ([Text], [Text])
mySpace Text
str
        new_space :: f [Text]
new_space = (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> Text
toTextUnsafe ([Focus] -> [Text]) -> f [Focus] -> f [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Focus) -> [Text] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText) [Text]
str_space
        new_str :: f Text
new_str = [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
interleave [Text]
str_nonspace ([Text] -> Text) -> f [Text] -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Text]
new_space
    in  Text -> Focus
FText (Text -> Focus) -> f Text -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_str

mySpace :: Text -> ([Text], [Text])
mySpace :: Text -> ([Text], [Text])
mySpace Text
"" = ([], [])
mySpace Text
str =
    let (Text
nonspace, Text
str') = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace Text
str
        (Text
space, Text
str'') = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isSpace Text
str'
        ([Text]
str_nonspace, [Text]
str_space) = Text -> ([Text], [Text])
mySpace Text
str''
    in  (Text
nonspace Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
str_nonspace, if Bool -> Bool
not (Text -> Bool
T.null Text
space) then Text
space Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
str_space else [Text]
str_space)

interleave :: [a] -> [a] -> [a]
interleave :: forall a. [a] -> [a] -> [a]
interleave [] [a]
a2s                = [a]
a2s
interleave [a]
a1s []                = [a]
a1s
interleave (a
a1 : [a]
a1s) (a
a2 : [a]
a2s) = a
a1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
a2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave [a]
a1s [a]
a2s

focusLines :: Focuser
focusLines :: Focuser
focusLines = Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
linesTrav

linesTrav :: Applicative f => (Focus -> f Focus) -> (Focus -> f Focus)
linesTrav :: Traversal' Focus Focus
linesTrav Focus -> f Focus
_ flst :: Focus
flst@(FList [Focus]
_) = Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
flst
linesTrav Focus -> f Focus
f (FText Text
str) = Text -> Focus
FText (Text -> Focus) -> ([Focus] -> Text) -> [Focus] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> ([Focus] -> [Text]) -> [Focus] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
`T.append` Text
"\n") (Text -> Text) -> (Focus -> Text) -> Focus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus -> Text
toTextUnsafe)
    ([Focus] -> Focus) -> f [Focus] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Focus) -> [Text] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText) (Text -> [Text]
T.lines Text
str)

transposeTravUnsafe :: Applicative f => (Focus -> f Focus) -> (Focus -> f Focus)
transposeTravUnsafe :: Traversal' Focus Focus
transposeTravUnsafe Focus -> f Focus
f Focus
flist = Focus -> Focus
transposeFListUnsafe (Focus -> Focus) -> f Focus -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Focus -> f Focus
f (Focus -> Focus
transposeFListUnsafe Focus
flist)

transposeFListUnsafe :: Focus -> Focus
transposeFListUnsafe :: Focus -> Focus
transposeFListUnsafe (FList [Focus]
lst) = [Focus] -> Focus
FList ([Focus] -> Focus) -> ([[Focus]] -> [Focus]) -> [[Focus]] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Focus] -> Focus) -> [[Focus]] -> [Focus]
forall a b. (a -> b) -> [a] -> [b]
map [Focus] -> Focus
FList ([[Focus]] -> Focus) -> [[Focus]] -> Focus
forall a b. (a -> b) -> a -> b
$ [[Focus]] -> [[Focus]]
forall a. [[a]] -> [[a]]
transpose (Focus -> [Focus]
toListUnsafe (Focus -> [Focus]) -> [Focus] -> [[Focus]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Focus]
lst)
transposeFListUnsafe Focus
_ =
    [Char] -> Focus
forall a. HasCallStack => [Char] -> a
error [Char]
"smh: transposeFListUnsafe called on a non-FList. Please, report this bug."

focusCols :: Focuser
focusCols :: Focuser
focusCols = Focuser -> Focuser
focusCollect (Focuser
focusLines Focuser -> Focuser -> Focuser
`composeFocusers` Focuser -> Focuser
focusCollect Focuser
focusWords)
    Focuser -> Focuser -> Focuser
`composeFocusers` Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
transposeTravUnsafe
    Focuser -> Focuser -> Focuser
`composeFocusers` Focuser
focusEach

focusSlice :: [Range] -> Focuser
focusSlice :: [Range] -> Focuser
focusSlice [Range]
ranges = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
str -> Text -> Focus
FText (Text -> Focus) -> f Text -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_str
      where
        str_length :: Int
str_length = Text -> Int
T.length Text
str
        is :: [Int]
is = [Range] -> Int -> [Int]
getIndexes [Range]
ranges Int
str_length
        filtered_str :: Text
filtered_str = Int -> [Int] -> Text -> Text
makeFilteredText Int
str_length [Int]
is Text
str
        new_filtered_str :: f Text
new_filtered_str = Focus -> Text
toTextUnsafe (Focus -> Text) -> f Focus -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> f Focus) -> Text -> f Focus
forall a b. (a -> b) -> a -> b
$ Text
filtered_str)
        new_str :: f Text
new_str = Text -> [Int] -> Text -> Text
updateText Text
str [Int]
is (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_filtered_str

    FList [Focus]
lst -> [Focus] -> Focus
FList ([Focus] -> Focus) -> f [Focus] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Focus]
new_lst
      where
        is :: [Int]
is = [Range] -> Int -> [Int]
getIndexes [Range]
ranges ([Focus] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Focus]
lst)
        filtered_lst :: [Focus]
filtered_lst = [Int] -> Int -> [Focus] -> [Focus]
forall {t} {a}. (Eq t, Num t) => [t] -> t -> [a] -> [a]
makeFilteredList [Int]
is Int
0 [Focus]
lst
        new_filtered_list :: f [Focus]
new_filtered_list = Focus -> [Focus]
toListUnsafe (Focus -> [Focus]) -> f Focus -> f [Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus
f (Focus -> f Focus) -> ([Focus] -> Focus) -> [Focus] -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focus] -> Focus
FList ([Focus] -> f Focus) -> [Focus] -> f Focus
forall a b. (a -> b) -> a -> b
$ [Focus]
filtered_lst)
        new_lst :: f [Focus]
new_lst = [Focus] -> [(Int, Focus)] -> [Focus]
forall a. [a] -> [(Int, a)] -> [a]
updateList [Focus]
lst ([(Int, Focus)] -> [Focus])
-> ([Focus] -> [(Int, Focus)]) -> [Focus] -> [Focus]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Focus] -> [(Int, Focus)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
is ([Focus] -> [Focus]) -> f [Focus] -> f [Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Focus]
new_filtered_list
  where
    makeFilteredList :: [t] -> t -> [a] -> [a]
makeFilteredList [] t
_ [a]
_ = []
    makeFilteredList [t]
_ t
_ [] = []
    makeFilteredList (t
i : [t]
is) t
idx (a
c : [a]
str)
        | t
idx t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
i = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [t] -> t -> [a] -> [a]
makeFilteredList [t]
is (t
idx t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [a]
str
        | Bool
otherwise = [t] -> t -> [a] -> [a]
makeFilteredList (t
i t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
is) (t
idx t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [a]
str

    updateList :: [a] -> [(Int, a)] -> [a]
    updateList :: forall a. [a] -> [(Int, a)] -> [a]
updateList [a]
as [(Int, a)]
updates = [(Int, a)] -> [(Int, a)] -> [a]
forall {a} {b}. Eq a => [(a, b)] -> [(a, b)] -> [b]
aux ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [a]
as) [(Int, a)]
updates
      where
        aux :: [(a, b)] -> [(a, b)] -> [b]
aux [(a, b)]
old [] = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
old
        aux [] [(a, b)]
_ = []
        aux ((a
i, b
a) : [(a, b)]
old) ((a
j, b
a') : [(a, b)]
updates)
            | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j = b
a' b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [b]
aux [(a, b)]
old [(a, b)]
updates
            | Bool
otherwise = b
a b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [b]
aux [(a, b)]
old ((a
j, b
a') (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
updates)

    updateText :: Text -> [Int] -> Text -> Text
    updateText :: Text -> [Int] -> Text -> Text
updateText Text
old [Int]
is Text
new = Int
-> ((Int, Int, [Int]) -> Maybe (Char, (Int, Int, [Int])))
-> (Int, Int, [Int])
-> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN (Int
oldLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
newLen) (Int, Int, [Int]) -> Maybe (Char, (Int, Int, [Int]))
builder (Int
0, Int
0, [Int]
is)
      where
        newLen :: Int
newLen = Text -> Int
T.length Text
new
        oldLen :: Int
oldLen = Text -> Int
T.length Text
old

        builder :: (Int, Int, [Int]) -> Maybe (Char, (Int, Int, [Int]))
        builder :: (Int, Int, [Int]) -> Maybe (Char, (Int, Int, [Int]))
builder (Int
oldI, Int
newI, [])
            | Int
newI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
newLen = (Char, (Int, Int, [Int])) -> Maybe (Char, (Int, Int, [Int]))
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
new Int
newI, (Int
oldI, Int
newI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, []))
            | Int
oldI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
oldLen = (Char, (Int, Int, [Int])) -> Maybe (Char, (Int, Int, [Int]))
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
old Int
oldI, (Int
oldI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
newI, []))
            | Bool
otherwise = Maybe (Char, (Int, Int, [Int]))
forall a. Maybe a
Nothing
        builder (Int
oldI, Int
newI, Int
i : [Int]
is)
            | Int
oldI Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = if Int
newI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
newLen
                then (Char, (Int, Int, [Int])) -> Maybe (Char, (Int, Int, [Int]))
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
new Int
newI, (Int
oldI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
newI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Int]
is))
                else (Int, Int, [Int]) -> Maybe (Char, (Int, Int, [Int]))
builder (Int
oldI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
newI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Int]
is)
            | Bool
otherwise = (Char, (Int, Int, [Int])) -> Maybe (Char, (Int, Int, [Int]))
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
old Int
oldI, (Int
oldI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
newI, Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
is))

focusSortedBy :: Focuser -> Focuser
focusSortedBy :: Focuser -> Focuser
focusSortedBy (FTrav Traversal' Focus Focus
trav) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
str ->
        let str_length :: Int
str_length = Text -> Int
T.length Text
str
            ([Int]
is, [Char]
sorted_str) = [(Int, Char)] -> ([Int], [Char])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, Char)] -> ([Int], [Char]))
-> [(Int, Char)] -> ([Int], [Char])
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Focus -> Focus -> Ordering
cmp (Focus -> Focus -> Ordering)
-> ((Int, Char) -> Focus) -> (Int, Char) -> (Int, Char) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text -> Focus
FText (Text -> Focus) -> ((Int, Char) -> Text) -> (Int, Char) -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Text) -> ((Int, Char) -> Char) -> (Int, Char) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd)) ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$
                [Int] -> [Char] -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Char] -> [(Int, Char)]) -> [Char] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
str
            new_sorted_str :: f Text
new_sorted_str = Focus -> Text
toTextUnsafe (Focus -> Text) -> f Focus -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText) ( [Char] -> Text
T.pack [Char]
sorted_str)
            unsort_is :: [Int]
unsort_is = [Int] -> Int -> [Int]
unsort [Int]
is Int
str_length
            new_str :: f Text
new_str = [Int] -> Int -> Text -> Text
unsortText [Int]
unsort_is Int
str_length (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_sorted_str
        in  Text -> Focus
FText (Text -> Focus) -> f Text -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_str
    FList [Focus]
lst ->
        let ([Integer]
is, [Focus]
sorted_lst) = [(Integer, Focus)] -> ([Integer], [Focus])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Integer, Focus)] -> ([Integer], [Focus]))
-> [(Integer, Focus)] -> ([Integer], [Focus])
forall a b. (a -> b) -> a -> b
$ ((Integer, Focus) -> (Integer, Focus) -> Ordering)
-> [(Integer, Focus)] -> [(Integer, Focus)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Focus -> Focus -> Ordering
cmp (Focus -> Focus -> Ordering)
-> ((Integer, Focus) -> Focus)
-> (Integer, Focus)
-> (Integer, Focus)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Integer, Focus) -> Focus
forall a b. (a, b) -> b
snd) ([(Integer, Focus)] -> [(Integer, Focus)])
-> [(Integer, Focus)] -> [(Integer, Focus)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Focus] -> [(Integer, Focus)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Focus]
lst
            new_sorted_lst :: f [Focus]
new_sorted_lst = Focus -> [Focus]
toListUnsafe (Focus -> [Focus]) -> f Focus -> f [Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus
f (Focus -> f Focus) -> ([Focus] -> Focus) -> [Focus] -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focus] -> Focus
FList) [Focus]
sorted_lst
            new_lst :: f [Focus]
new_lst = ((Integer, Focus) -> Focus) -> [(Integer, Focus)] -> [Focus]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Focus) -> Focus
forall a b. (a, b) -> b
snd ([(Integer, Focus)] -> [Focus])
-> ([Focus] -> [(Integer, Focus)]) -> [Focus] -> [Focus]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Focus) -> (Integer, Focus) -> Ordering)
-> [(Integer, Focus)] -> [(Integer, Focus)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Integer, Focus) -> Integer)
-> (Integer, Focus) -> (Integer, Focus) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Integer, Focus) -> Integer
forall a b. (a, b) -> a
fst) ([(Integer, Focus)] -> [(Integer, Focus)])
-> ([Focus] -> [(Integer, Focus)]) -> [Focus] -> [(Integer, Focus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Focus] -> [(Integer, Focus)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
is ([Focus] -> [Focus]) -> f [Focus] -> f [Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Focus]
new_sorted_lst
        in  [Focus] -> Focus
FList ([Focus] -> Focus) -> f [Focus] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Focus]
new_lst
  where
    cmp :: Focus -> Focus -> Ordering
cmp Focus
f1 Focus
f2 =
        let f1' :: [Focus]
f1' = Focus
f1 Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav
            f2' :: [Focus]
f2' = Focus
f2 Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav
        in case ([Focus]
f1', [Focus]
f2') of
            ([FText Text
s1], [FText Text
s2]) -> case (Text -> Maybe Double
readMDouble Text
s1, Text -> Maybe Double
readMDouble Text
s2) of
                (Just Double
n1, Just Double
n2) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
n1 Double
n2
                (Maybe Double, Maybe Double)
_                  -> Ordering
EQ
            ([Focus], [Focus])
_ -> Ordering
EQ

    unsortText :: [Int] -> Int -> Text -> Text
    unsortText :: [Int] -> Int -> Text -> Text
unsortText [Int]
is Int
strLen Text
str = Int -> ([Int] -> Maybe (Char, [Int])) -> [Int] -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN Int
strLen [Int] -> Maybe (Char, [Int])
builder [Int]
is
      where
        builder :: [Int] -> Maybe (Char, [Int])
        builder :: [Int] -> Maybe (Char, [Int])
builder []       = Maybe (Char, [Int])
forall a. Maybe a
Nothing
        builder (Int
i : [Int]
is) = (Char, [Int]) -> Maybe (Char, [Int])
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
str Int
i, [Int]
is)


    readMDouble :: Text -> Maybe Double
    readMDouble :: Text -> Maybe Double
readMDouble = [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Double)
-> (Text -> [Char]) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

focusIndex :: Int -> Focuser
focusIndex :: Int -> Focuser
focusIndex Int
n_ = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
str -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
str then Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus else
        (Focus -> f Focus
f (Focus -> f Focus) -> (Char -> Focus) -> Char -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Char -> Text) -> Char -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
str Int
n) f Focus -> (Focus -> Focus) -> f Focus
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Focus
new_str ->
            case Focus -> Text
toTextUnsafe Focus
new_str of
                Text
""   -> Text -> Focus
FText Text
str
                Text
text -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Int -> Char -> Text
updateTextAt Int
str_length Text
str Int
n (HasCallStack => Text -> Char
Text -> Char
T.head Text
text)
      where
        str_length :: Int
str_length = Text -> Int
T.length Text
str
        n :: Int
n = if Int
n_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
str_length Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n_ else Int
n_
    FList [Focus]
lst -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Focus] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Focus]
lst then Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus else
        let new_focus :: f Focus
new_focus = Focus -> f Focus
f ([Focus]
lst [Focus] -> Int -> Focus
forall a. HasCallStack => [a] -> Int -> a
!! Int
n)
            in [Focus] -> Focus
FList ([Focus] -> Focus) -> (Focus -> [Focus]) -> Focus -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focus] -> Int -> Focus -> [Focus]
forall a. [a] -> Int -> a -> [a]
updateListAt [Focus]
lst Int
n (Focus -> Focus) -> f Focus -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Focus
new_focus
      where
        n :: Int
n = if Int
n_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then [Focus] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Focus]
lst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n_ else Int
n_
  where
    updateListAt :: [a] -> Int -> a -> [a]
    updateListAt :: forall a. [a] -> Int -> a -> [a]
updateListAt [] Int
_ a
_         = []
    updateListAt (a
_ : [a]
olds) Int
0 a
a = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
olds
    updateListAt (a
o : [a]
olds) Int
n a
a = a
o a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> Int -> a -> [a]
forall a. [a] -> Int -> a -> [a]
updateListAt [a]
olds (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
a

    updateTextAt :: Int -> Text -> Int -> Char -> Text
    updateTextAt :: Int -> Text -> Int -> Char -> Text
updateTextAt Int
strLen Text
str Int
i Char
newC = Int -> (Int -> Maybe (Char, Int)) -> Int -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN Int
strLen Int -> Maybe (Char, Int)
builder Int
0
      where
        builder :: Int -> Maybe (Char, Int)
        builder :: Int -> Maybe (Char, Int)
builder Int
n
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
strLen = Maybe (Char, Int)
forall a. Maybe a
Nothing
            | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i    = (Char, Int) -> Maybe (Char, Int)
forall a. a -> Maybe a
Just (Char
newC, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            | Bool
otherwise = (Char, Int) -> Maybe (Char, Int)
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
str Int
n, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

focusMinBy :: Focuser -> Focuser
focusMinBy :: Focuser -> Focuser
focusMinBy Focuser
f = Focuser -> Focuser
focusSortedBy Focuser
f Focuser -> Focuser -> Focuser
`composeFocusers` Int -> Focuser
focusIndex Int
0

focusMaxBy :: Focuser -> Focuser
focusMaxBy :: Focuser -> Focuser
focusMaxBy Focuser
f = Focuser -> Focuser
focusSortedBy Focuser
f Focuser -> Focuser -> Focuser
`composeFocusers` Int -> Focuser
focusIndex (-Int
1)

focusSortedLexBy :: Focuser -> Focuser
focusSortedLexBy :: Focuser -> Focuser
focusSortedLexBy (FTrav Traversal' Focus Focus
trav) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
str ->
        let ([Int]
is, [Char]
sorted_str) = [(Int, Char)] -> ([Int], [Char])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, Char)] -> ([Int], [Char]))
-> [(Int, Char)] -> ([Int], [Char])
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> (Int, Char) -> Ordering)
-> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Focus -> Focus -> Ordering
cmp (Focus -> Focus -> Ordering)
-> ((Int, Char) -> Focus) -> (Int, Char) -> (Int, Char) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text -> Focus
FText (Text -> Focus) -> ((Int, Char) -> Text) -> (Int, Char) -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Text) -> ((Int, Char) -> Char) -> (Int, Char) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd)) ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$
                [Int] -> [Char] -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Char] -> [(Int, Char)]) -> [Char] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
str
            str_length :: Int
str_length = Text -> Int
T.length Text
str
            new_sorted_str :: f Text
new_sorted_str = Focus -> Text
toTextUnsafe (Focus -> Text) -> f Focus -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus
f (Focus -> f Focus) -> ([Char] -> Focus) -> [Char] -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> ([Char] -> Text) -> [Char] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) [Char]
sorted_str
            unsort_is :: [Int]
unsort_is = [Int] -> Int -> [Int]
unsort [Int]
is Int
str_length
            new_str :: f Text
new_str = [Int] -> Int -> Text -> Text
unsortText [Int]
unsort_is Int
str_length (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_sorted_str
        in  Text -> Focus
FText (Text -> Focus) -> f Text -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
new_str
    FList [Focus]
lst ->
        let ([Integer]
is, [Focus]
sorted_lst) = [(Integer, Focus)] -> ([Integer], [Focus])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Integer, Focus)] -> ([Integer], [Focus]))
-> [(Integer, Focus)] -> ([Integer], [Focus])
forall a b. (a -> b) -> a -> b
$ ((Integer, Focus) -> (Integer, Focus) -> Ordering)
-> [(Integer, Focus)] -> [(Integer, Focus)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Focus -> Focus -> Ordering
cmp (Focus -> Focus -> Ordering)
-> ((Integer, Focus) -> Focus)
-> (Integer, Focus)
-> (Integer, Focus)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Integer, Focus) -> Focus
forall a b. (a, b) -> b
snd) ([(Integer, Focus)] -> [(Integer, Focus)])
-> [(Integer, Focus)] -> [(Integer, Focus)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Focus] -> [(Integer, Focus)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Focus]
lst
            new_sorted_lst :: f [Focus]
new_sorted_lst = Focus -> [Focus]
toListUnsafe (Focus -> [Focus]) -> f Focus -> f [Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Focus -> f Focus
f (Focus -> f Focus) -> ([Focus] -> Focus) -> [Focus] -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focus] -> Focus
FList) [Focus]
sorted_lst
            new_lst :: f [Focus]
new_lst = ((Integer, Focus) -> Focus) -> [(Integer, Focus)] -> [Focus]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Focus) -> Focus
forall a b. (a, b) -> b
snd ([(Integer, Focus)] -> [Focus])
-> ([Focus] -> [(Integer, Focus)]) -> [Focus] -> [Focus]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Focus) -> (Integer, Focus) -> Ordering)
-> [(Integer, Focus)] -> [(Integer, Focus)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Integer, Focus) -> Integer)
-> (Integer, Focus) -> (Integer, Focus) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Integer, Focus) -> Integer
forall a b. (a, b) -> a
fst) ([(Integer, Focus)] -> [(Integer, Focus)])
-> ([Focus] -> [(Integer, Focus)]) -> [Focus] -> [(Integer, Focus)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Focus] -> [(Integer, Focus)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
is ([Focus] -> [Focus]) -> f [Focus] -> f [Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Focus]
new_sorted_lst
        in  [Focus] -> Focus
FList ([Focus] -> Focus) -> f [Focus] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Focus]
new_lst
  where
    cmp :: Focus -> Focus -> Ordering
cmp Focus
f1 Focus
f2 =
        let f1' :: [Focus]
f1' = Focus
f1 Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav
            f2' :: [Focus]
f2' = Focus
f2 Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav
        in case ([Focus]
f1', [Focus]
f2') of
            ([FText Text
s1], [FText Text
s2]) -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
s1 Text
s2
            ([Focus], [Focus])
_                        -> Ordering
EQ

    unsortText :: [Int] -> Int -> Text -> Text
    unsortText :: [Int] -> Int -> Text -> Text
unsortText [Int]
is Int
strLen Text
str = Int -> ([Int] -> Maybe (Char, [Int])) -> [Int] -> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN Int
strLen [Int] -> Maybe (Char, [Int])
builder [Int]
is
      where
        builder :: [Int] -> Maybe (Char, [Int])
        builder :: [Int] -> Maybe (Char, [Int])
builder []       = Maybe (Char, [Int])
forall a. Maybe a
Nothing
        builder (Int
i : [Int]
is) = (Char, [Int]) -> Maybe (Char, [Int])
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
str Int
i, [Int]
is)

focusMinLexBy :: Focuser -> Focuser
focusMinLexBy :: Focuser -> Focuser
focusMinLexBy Focuser
f = Focuser -> Focuser
focusSortedLexBy Focuser
f Focuser -> Focuser -> Focuser
`composeFocusers` Int -> Focuser
focusIndex Int
0

focusMaxLexBy :: Focuser -> Focuser
focusMaxLexBy :: Focuser -> Focuser
focusMaxLexBy Focuser
f = Focuser -> Focuser
focusSortedLexBy Focuser
f Focuser -> Focuser -> Focuser
`composeFocusers` Int -> Focuser
focusIndex (-Int
1)

focusSum :: Focuser
focusSum :: Focuser
focusSum = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Focus -> Focus
getSum Focus -> Focus -> Focus
forall a b. a -> b -> a
const

getSum :: Focus -> Focus
getSum :: Focus -> Focus
getSum Focus
focus = case Focus
focus of
    FList [Focus]
_ -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Text
showRational (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Rational) -> [Text] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Rational
readMaybeRational ([Text] -> [Rational]) -> [Text] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Focus
focus Focus -> Getting (Endo [Text]) Focus Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Text]) Focus Text
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' Focus Text
biplate
    FText Text
s -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Text
showRational (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$
        (Char -> Maybe Rational) -> [Char] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Rational
readMaybeRational (Text -> Maybe Rational)
-> (Char -> Text) -> Char -> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) ([Char] -> [Rational]) -> [Char] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s

focusProduct :: Focuser
focusProduct :: Focuser
focusProduct = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Focus -> Focus
getProduct Focus -> Focus -> Focus
forall a b. a -> b -> a
const

getProduct :: Focus -> Focus
getProduct :: Focus -> Focus
getProduct Focus
focus = case Focus
focus of
    FList [Focus]
_ -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Text
showRational (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Rational) -> [Text] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Rational
readMaybeRational ([Text] -> [Rational]) -> [Text] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Focus
focus Focus -> Getting (Endo [Text]) Focus Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Text]) Focus Text
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' Focus Text
biplate
    FText Text
s -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Text
showRational (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$
        (Char -> Maybe Rational) -> [Char] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Rational
readMaybeRational (Text -> Maybe Rational)
-> (Char -> Text) -> Char -> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) ([Char] -> [Rational]) -> [Char] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s

focusAverage :: Rational -> Focuser
focusAverage :: Rational -> Focuser
focusAverage Rational
n = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Rational -> Focus -> Focus
getAverage Rational
n) Focus -> Focus -> Focus
forall a b. a -> b -> a
const

getAverage :: Rational -> Focus -> Focus
getAverage :: Rational -> Focus -> Focus
getAverage Rational
n Focus
focus = case Focus
focus of
    FList [Focus]
_ -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Text
showRational (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ Rational -> [Rational] -> Rational
average Rational
n ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Rational) -> [Text] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Rational
readMaybeRational ([Text] -> [Rational]) -> [Text] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Focus
focus Focus -> Getting (Endo [Text]) Focus Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Text]) Focus Text
forall s a. (Data s, Typeable a) => Traversal' s a
Traversal' Focus Text
biplate
    FText Text
s -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Text
showRational (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ Rational -> [Rational] -> Rational
average Rational
n ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$
        (Char -> Maybe Rational) -> [Char] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Rational
readMaybeRational (Text -> Maybe Rational)
-> (Char -> Text) -> Char -> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) ([Char] -> [Rational]) -> [Char] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s

average :: Rational -> [Rational] -> Rational
average :: Rational -> [Rational] -> Rational
average Rational
n [] = Rational
n
average Rational
_ [Rational]
xs = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
xs Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Rational] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rational]
xs)





focusIf :: Focuser -> Focuser
focusIf :: Focuser -> Focuser
focusIf (FTrav Traversal' Focus Focus
trav) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
trav of
    [FText Text
"1"] -> Focus -> f Focus
f Focus
focus
    [Focus]
_           -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus

logicFocuser :: (Focus -> Bool) -> Focuser
logicFocuser :: (Focus -> Bool) -> Focuser
logicFocuser Focus -> Bool
pred = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\Focus
focus -> if Focus -> Bool
pred Focus
focus
        then Text -> Focus
FText Text
"1"
        else Text -> Focus
FText Text
"0")
    Focus -> Focus -> Focus
forall a b. a -> b -> a
const

focusIsUpper :: Focuser
focusIsUpper :: Focuser
focusIsUpper = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isUpper Text
s
    Focus
_         -> Bool
False)

focusIsLower :: Focuser
focusIsLower :: Focuser
focusIsLower = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
s
    Focus
_         -> Bool
False)

focusIsAlpha :: Focuser
focusIsAlpha :: Focuser
focusIsAlpha = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlpha Text
s
    Focus
_         -> Bool
False)

focusIsAlphaNum :: Focuser
focusIsAlphaNum :: Focuser
focusIsAlphaNum = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
s
    Focus
_         -> Bool
False)

focusIsDigit :: Focuser
focusIsDigit :: Focuser
focusIsDigit = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
s
    Focus
_         -> Bool
False)

focusIsSpace :: Focuser
focusIsSpace :: Focuser
focusIsSpace = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
    Focus
_         -> Bool
False)

focusIsNumber :: Focuser
focusIsNumber :: Focuser
focusIsNumber = (Focus -> Bool) -> Focuser
logicFocuser (\case
    FText Text
s -> case Text -> Maybe Rational
readMaybeRational Text
s of
        Just Rational
_  -> Bool
True
        Maybe Rational
Nothing -> Bool
False
    Focus
_         -> Bool
False)

focusRegex :: Text -> Focuser
focusRegex :: Text -> Focuser
focusRegex Text
regex = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
s ->
        let matchIdxs :: [(Int, Int)]
matchIdxs = AllMatches [] (Int, Int) -> [(Int, Int)]
forall (f :: * -> *) b. AllMatches f b -> f b
getAllMatches (Text
s Text -> Text -> AllMatches [] (Int, Int)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text
regex)
            ([Text]
nonMatches, [Text]
matches) = Int -> Text -> [(Int, Int)] -> ([Text], [Text])
fromIndexes Int
0 Text
s [(Int, Int)]
matchIdxs
            newMatches :: f [Text]
newMatches = (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> Text
toTextUnsafe ([Focus] -> [Text]) -> f [Focus] -> f [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Focus) -> [Text] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText) [Text]
matches
        in  Text -> Focus
FText (Text -> Focus) -> ([Text] -> Text) -> [Text] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
interleave [Text]
nonMatches ([Text] -> Focus) -> f [Text] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Text]
newMatches
    Focus
_ -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus

focusFilter :: Focuser -> Focuser
focusFilter :: Focuser -> Focuser
focusFilter Focuser
ftrav = Focuser -> Focuser
focusCollect (Focuser -> Focuser) -> Focuser -> Focuser
forall a b. (a -> b) -> a -> b
$ Focuser
focusEach Focuser -> Focuser -> Focuser
`composeFocusers` Focuser -> Focuser
focusIf Focuser
ftrav

focusContains :: Text -> Focuser
focusContains :: Text -> Focuser
focusContains Text
text = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Focus -> Focus
contains Focus -> Focus -> Focus
forall a b. a -> b -> a
const
  where
    contains :: Focus -> Focus
contains Focus
focus = case Focus
focus of
        FText Text
s   -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ if Text -> Text -> Bool
T.isInfixOf Text
text Text
s then Text
"1" else Text
"0"
        FList [Focus]
lst -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ if (Focus -> Bool) -> [Focus] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Focus -> Bool
check [Focus]
lst then Text
"1" else Text
"0"
    check :: Focus -> Bool
check Focus
focus = case Focus
focus of
        FText Text
s -> Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s
        Focus
_       -> Bool
False

focusStartsWith :: Text -> Focuser
focusStartsWith :: Text -> Focuser
focusStartsWith Text
text = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Focus -> Focus
starts Focus -> Focus -> Focus
forall a b. a -> b -> a
const
  where
    starts :: Focus -> Focus
starts Focus
focus = case Focus
focus of
        FText Text
s -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ if Text -> Text -> Bool
T.isPrefixOf Text
text Text
s then Text
"1" else Text
"0"
        Focus
_       -> Text -> Focus
FText Text
"0"

focusEndsWith :: Text -> Focuser
focusEndsWith :: Text -> Focuser
focusEndsWith Text
text = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Focus -> Focus
ends Focus -> Focus -> Focus
forall a b. a -> b -> a
const
  where
    ends :: Focus -> Focus
ends Focus
focus = case Focus
focus of
        FText Text
s -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ if Text -> Text -> Bool
T.isSuffixOf Text
text Text
s then Text
"1" else Text
"0"
        Focus
_       -> Text -> Focus
FText Text
"0"

focusLength :: Focuser
focusLength :: Focuser
focusLength = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    fs :: Focus
fs@(FText Text
s)     -> Focus
fs Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Focus -> f Focus
f (Text -> Focus
FText (Text -> Focus) -> (Text -> Text) -> Text -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (Text -> Int) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Text
s)
    flst :: Focus
flst@(FList [Focus]
lst) -> Focus
flst Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Focus -> f Focus
f (Text -> Focus
FText (Text -> Focus) -> ([Focus] -> Text) -> [Focus] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> ([Focus] -> [Char]) -> [Focus] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> ([Focus] -> Int) -> [Focus] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focus] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Focus] -> Focus) -> [Focus] -> Focus
forall a b. (a -> b) -> a -> b
$ [Focus]
lst)

parseListElemIdxs :: Parser [(Int, Int)]
parseListElemIdxs :: Parser [(Int, Int)]
parseListElemIdxs = do
    Text -> Parser Text
symbol Text
"["
    [(Int, Int)]
idxs <- Parser (Int, Int)
parseElemIdxs Parser (Int, Int) -> Parser Text -> Parser [(Int, Int)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Text -> Parser Text
symbol Text
","
    Text -> Parser Text
symbol Text
"]"
    [(Int, Int)] -> Parser [(Int, Int)]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Int, Int)]
idxs

parseElemIdxs :: Parser (Int, Int)
parseElemIdxs :: Parser (Int, Int)
parseElemIdxs = Parser (Int, Int) -> Parser (Int, Int)
forall a. Parser a -> Parser a
lexeme (Parser (Int, Int) -> Parser (Int, Int))
-> Parser (Int, Int) -> Parser (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
    Int
idx1 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Parser ()
skipListElem
    Int
idx2 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    (Int, Int) -> Parser (Int, Int)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
idx1, Int
idx2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx1)

skipListElem :: Parser ()
skipListElem :: Parser ()
skipListElem = [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser ()
inQuotes
    , Parser ()
inDoubleQuotes
    , Parser ()
inSquareBraces
    , Parser ()
inParens
    , Parser ()
inCurlyBraces
    , Parser ()
escapingCommaSquareBrace]
    Parser () -> 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 (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
ws Parser () -> 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
>> Parser ()
skipListElem))

inQuotes :: Parser ()
inQuotes = 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 -> 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
>> Char -> Char -> Int -> Parser ()
escaping Char
'\'' Char
'\'' Int
1
inDoubleQuotes :: Parser ()
inDoubleQuotes = 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 -> 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
>> Char -> Char -> Int -> Parser ()
escaping Char
'"' Char
'"' Int
1
inSquareBraces :: Parser ()
inSquareBraces = 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 -> 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
>> Char -> Char -> Int -> Parser ()
escaping Char
'[' Char
']' Int
1
inParens :: Parser ()
inParens = 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 -> 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
>> Char -> Char -> Int -> Parser ()
escaping Char
'(' Char
')' Int
1
inCurlyBraces :: Parser ()
inCurlyBraces = 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 -> 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
>> Char -> Char -> Int -> Parser ()
escaping Char
'{' Char
'}' Int
1
escapingCommaSquareBrace :: Parser ()
escapingCommaSquareBrace = ParsecT Void Text Identity [Token Text] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [Token Text] -> Parser ())
-> ParsecT Void Text Identity [Token Text] -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [Token Text])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
Token Text
c))

escaping :: Char -> Char -> Int -> Parser ()
escaping :: Char -> Char -> Int -> Parser ()
escaping Char
start Char
end Int
depth = [Parser ()] -> Parser ()
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
end ParsecT Void Text Identity Char -> 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
>> if Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then () -> Parser ()
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () else ParsecT Void Text Identity (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> ParsecT Void Text Identity (Maybe ()))
-> Parser () -> ParsecT Void Text Identity (Maybe ())
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Int -> Parser ()
escaping Char
start Char
end (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
    , 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
start ParsecT Void Text Identity Char -> 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 (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> ParsecT Void Text Identity (Maybe ()))
-> Parser () -> ParsecT Void Text Identity (Maybe ())
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Int -> Parser ()
escaping Char
start Char
end (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    , 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 (Token Text)
-> ParsecT Void Text Identity (Token Text)
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)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity (Token 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 (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> ParsecT Void Text Identity (Maybe ()))
-> Parser () -> ParsecT Void Text Identity (Maybe ())
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Int -> Parser ()
escaping Char
start Char
end Int
depth)
    , ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity (Token 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 (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> ParsecT Void Text Identity (Maybe ()))
-> Parser () -> ParsecT Void Text Identity (Maybe ())
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Int -> Parser ()
escaping Char
start Char
end Int
depth)
    ]

focusEl :: Focuser
focusEl :: Focuser
focusEl = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
s -> case Parser [(Int, Int)] -> Text -> Maybe [(Int, Int)]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parser [(Int, Int)]
parseListElemIdxs Text
s of
        Just [(Int, Int)]
idxs ->
            let ([Text]
nonMatches, [Text]
matches) = Int -> Text -> [(Int, Int)] -> ([Text], [Text])
fromIndexes Int
0 Text
s [(Int, Int)]
idxs
                newMatches :: f [Text]
newMatches = (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> Text
toTextUnsafe ([Focus] -> [Text]) -> f [Focus] -> f [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Focus) -> [Text] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Focus -> f Focus
f (Focus -> f Focus) -> (Text -> Focus) -> Text -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText) [Text]
matches
            in  Text -> Focus
FText (Text -> Focus) -> ([Text] -> Text) -> [Text] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
interleave [Text]
nonMatches ([Text] -> Focus) -> f [Text] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Text]
newMatches
        Maybe [(Int, Int)]
Nothing -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus
    FList [Focus]
_ -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus

parseObjKVIdxs :: Parser [((Int, Int), (Int, Int))]
parseObjKVIdxs :: Parser [((Int, Int), (Int, Int))]
parseObjKVIdxs = do
    Text -> Parser Text
symbol Text
"{"
    [((Int, Int), (Int, Int))]
idxs <- Parser ((Int, Int), (Int, Int))
parseKVIdxs Parser ((Int, Int), (Int, Int))
-> Parser Text -> Parser [((Int, Int), (Int, Int))]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Text -> Parser Text
symbol Text
","
    Text -> Parser Text
symbol Text
"}"
    [((Int, Int), (Int, Int))] -> Parser [((Int, Int), (Int, Int))]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [((Int, Int), (Int, Int))]
idxs

parseKVIdxs :: Parser ((Int, Int), (Int, Int))
parseKVIdxs :: Parser ((Int, Int), (Int, Int))
parseKVIdxs = do
    (Int, Int)
keyIdxs <- Parser (Int, Int)
parseKeyIdxs
    Text -> Parser Text
symbol Text
":"
    (Int, Int)
valIdxs <- Parser (Int, Int)
parseValIdxs
    ((Int, Int), (Int, Int)) -> Parser ((Int, Int), (Int, Int))
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, Int)
keyIdxs, (Int, Int)
valIdxs)

parseKeyIdxs :: Parser (Int, Int)
parseKeyIdxs :: Parser (Int, Int)
parseKeyIdxs = Parser (Int, Int) -> Parser (Int, Int)
forall a. Parser a -> Parser a
lexeme (Parser (Int, Int) -> Parser (Int, Int))
-> Parser (Int, Int) -> Parser (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
    Int
idx1 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Parser ()
skipKey
    Int
idx2 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    (Int, Int) -> Parser (Int, Int)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
idx1, Int
idx2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx1)

skipKey :: Parser ()
skipKey :: Parser ()
skipKey = [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser ()
inQuotes
    , Parser ()
inDoubleQuotes
    , Parser ()
inSquareBraces
    , Parser ()
inParens
    , Parser ()
inCurlyBraces
    , Parser ()
escapingColonCurlyBrace]
    Parser () -> 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 (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
ws Parser () -> 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
>> Parser ()
skipKey))

escapingColonCurlyBrace :: Parser ()
escapingColonCurlyBrace = ParsecT Void Text Identity [Token Text] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [Token Text] -> Parser ())
-> ParsecT Void Text Identity [Token Text] -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [Token Text])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
Token Text
c))

parseValIdxs :: Parser (Int, Int)
parseValIdxs :: Parser (Int, Int)
parseValIdxs = Parser (Int, Int) -> Parser (Int, Int)
forall a. Parser a -> Parser a
lexeme (Parser (Int, Int) -> Parser (Int, Int))
-> Parser (Int, Int) -> Parser (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
    Int
idx1 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Parser ()
skipVal
    Int
idx2 <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    (Int, Int) -> Parser (Int, Int)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
idx1, Int
idx2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx1)

skipVal :: Parser ()
skipVal :: Parser ()
skipVal = [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser ()
inQuotes
    , Parser ()
inDoubleQuotes
    , Parser ()
inSquareBraces
    , Parser ()
inParens
    , Parser ()
inCurlyBraces
    , Parser ()
escapingCommaCurlyBrace]
    Parser () -> 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 (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
ws Parser () -> 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
>> Parser ()
skipVal))

escapingCommaCurlyBrace :: Parser ()
escapingCommaCurlyBrace = ParsecT Void Text Identity [Token Text] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [Token Text] -> Parser ())
-> ParsecT Void Text Identity [Token Text] -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity (Token Text)
 -> ParsecT Void Text Identity [Token Text])
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
Token Text
c))

focusKV :: Focuser
focusKV :: Focuser
focusKV = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FText Text
s -> case Parser [((Int, Int), (Int, Int))]
-> Text -> Maybe [((Int, Int), (Int, Int))]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parser [((Int, Int), (Int, Int))]
parseObjKVIdxs Text
s of
        Just [((Int, Int), (Int, Int))]
idxs ->
            let idxs_ :: [(Int, Int)]
idxs_ = (((Int, Int), (Int, Int)) -> [(Int, Int)])
-> [((Int, Int), (Int, Int))] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\((Int, Int)
a, (Int, Int)
b) -> [(Int, Int)
a, (Int, Int)
b]) [((Int, Int), (Int, Int))]
idxs
                ([Text]
nonMatches, [Text]
matches) = Int -> Text -> [(Int, Int)] -> ([Text], [Text])
fromIndexes Int
0 Text
s [(Int, Int)]
idxs_
                matches_ :: [[Focus]]
matches_ = [Focus] -> [[Focus]]
forall a. [a] -> [[a]]
pairUp ([Focus] -> [[Focus]]) -> [Focus] -> [[Focus]]
forall a b. (a -> b) -> a -> b
$ (Text -> Focus) -> [Text] -> [Focus]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Focus
FText [Text]
matches
                newMatches_ :: f [[Focus]]
newMatches_ = (Focus -> [Focus]) -> [Focus] -> [[Focus]]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> [Focus]
toListUnsafe ([Focus] -> [[Focus]]) -> f [Focus] -> f [[Focus]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Focus] -> f Focus) -> [[Focus]] -> f [Focus]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Focus -> f Focus
f (Focus -> f Focus) -> ([Focus] -> Focus) -> [Focus] -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Focus] -> Focus
FList) [[Focus]]
matches_
                newMatches :: f [Text]
newMatches = (Focus -> Text) -> [Focus] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Focus -> Text
toTextUnsafe ([Focus] -> [Text])
-> ([[Focus]] -> [Focus]) -> [[Focus]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Focus]] -> [Focus]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Focus]] -> [Text]) -> f [[Focus]] -> f [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [[Focus]]
newMatches_
            in  Text -> Focus
FText (Text -> Focus) -> ([Text] -> Text) -> [Text] -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
interleave [Text]
nonMatches ([Text] -> Focus) -> f [Text] -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Text]
newMatches
        Maybe [((Int, Int), (Int, Int))]
Nothing -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus
    FList [Focus]
_ -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus
  where
    pairUp :: [a] -> [[a]]
    pairUp :: forall a. [a] -> [[a]]
pairUp []             = []
    pairUp (a
a1 : a
a2 : [a]
as) = [a
a1, a
a2] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
pairUp [a]
as
    pairUp [a]
_              = [Char] -> [[a]]
forall a. HasCallStack => [Char] -> a
error [Char]
"pairUp: list too short"

data KeyType
    = InQuotes Text
    | InDoubleQuotes Text
    | Default

focusKey :: Focuser
focusKey :: Focuser
focusKey = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FList [FText Text
key, FText Text
val] -> case Text -> KeyType
stripKey Text
key of
        InQuotes Text
key_ -> Text -> Text -> Focus
setKey Text
val (Text -> Focus) -> (Focus -> Text) -> Focus -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
k -> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") (Text -> Text) -> (Focus -> Text) -> Focus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus -> Text
toTextUnsafe (Focus -> Focus) -> f Focus -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Focus -> f Focus
f (Text -> Focus
FText Text
key_)
        InDoubleQuotes Text
key_ -> Text -> Text -> Focus
setKey Text
val (Text -> Focus) -> (Focus -> Text) -> Focus -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
k -> Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") (Text -> Text) -> (Focus -> Text) -> Focus -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus -> Text
toTextUnsafe (Focus -> Focus) -> f Focus -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Focus -> f Focus
f (Text -> Focus
FText Text
key_)
        KeyType
Default -> Text -> Text -> Focus
setKey Text
val (Text -> Focus) -> (Focus -> Text) -> Focus -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus -> Text
toTextUnsafe (Focus -> Focus) -> f Focus -> f Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Focus -> f Focus
f (Text -> Focus
FText Text
key)
    FText Text
_ ->
        let FTrav Traversal' Focus Focus
trav = Focuser
focusKV Focuser -> Focuser -> Focuser
`composeFocusers` Focuser
focusKey
        in  (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
trav Focus -> f Focus
f Focus
focus

stripKey :: Text -> KeyType
stripKey :: Text -> KeyType
stripKey Text
s
    | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
s Int
0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
s (Text -> Int
T.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' =
        Text -> KeyType
InDoubleQuotes (Text -> KeyType) -> Text -> KeyType
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.dropEnd Int
1 Text
s
    | HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
s Int
0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
&& HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
s (Text -> Int
T.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''=
        Text -> KeyType
InQuotes (Text -> KeyType) -> Text -> KeyType
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.dropEnd Int
1 Text
s
    | Bool
otherwise = KeyType
Default

setKey :: Text -> Text -> Focus
setKey :: Text -> Text -> Focus
setKey Text
val Text
key = [Focus] -> Focus
FList [Text -> Focus
FText Text
key, Text -> Focus
FText Text
val]

focusVal :: Focuser
focusVal :: Focuser
focusVal = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus -> case Focus
focus of
    FList [Focus]
_ ->
        let FTrav Traversal' Focus Focus
trav = Int -> Focuser
focusIndex Int
1
        in  (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
trav Focus -> f Focus
f Focus
focus
    FText Text
_ ->
        let FTrav Traversal' Focus Focus
trav = Focuser
focusKV Focuser -> Focuser -> Focuser
`composeFocusers` Focuser
focusVal
        in  (Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
trav Focus -> f Focus
f Focus
focus

focusAtKey :: Text -> Focuser
focusAtKey :: Text -> Focuser
focusAtKey Text
key = Focuser
focusKV
    Focuser -> Focuser -> Focuser
`composeFocusers` Focuser -> Focuser
focusIf ((forall a. Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Focuser
focusKey (Text -> Focuser
focusConst Text
key))
    Focuser -> Focuser -> Focuser
`composeFocusers` Focuser
focusVal

focusAtIdx :: Int -> Focuser
focusAtIdx :: Int -> Focuser
focusAtIdx Int
i = Focuser -> Focuser
focusCollect Focuser
focusEl Focuser -> Focuser -> Focuser
`composeFocusers` Int -> Focuser
focusIndex Int
i

textToBool :: Text -> Bool
textToBool :: Text -> Bool
textToBool = \case
    Text
"1" -> Bool
True
    Text
_   -> Bool
False

boolToText :: Bool -> Text
boolToText :: Bool -> Text
boolToText = \case
    Bool
True  -> Text
"1"
    Bool
False -> Text
"0"

focusLogic2 :: (Bool -> Bool -> Bool) -> Focuser -> Focuser -> Focuser
focusLogic2 :: (Bool -> Bool -> Bool) -> Focuser -> Focuser -> Focuser
focusLogic2 Bool -> Bool -> Bool
op (FTrav Traversal' Focus Focus
t1) (FTrav Traversal' Focus Focus
t2) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus ->
    case (Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t1, Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t2) of
    ([FText Text
s1], [FText Text
s2]) ->
        let b1 :: Bool
b1 = Text -> Bool
textToBool Text
s1
            b2 :: Bool
b2 = Text -> Bool
textToBool Text
s2
        in  Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
op Bool
b1 Bool
b2)

focusToMaybeBool :: Focus -> Maybe Bool
focusToMaybeBool :: Focus -> Maybe Bool
focusToMaybeBool = \case
    FText Text
s -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
textToBool Text
s
    FList [Focus]
_ -> Maybe Bool
forall a. Maybe a
Nothing

focusLogicMany :: ([Bool] -> Bool) -> Focuser -> Focuser
focusLogicMany :: ([Bool] -> Bool) -> Focuser -> Focuser
focusLogicMany [Bool] -> Bool
op (FTrav Traversal' Focus Focus
t) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus ->
    case (Focus -> Maybe Bool) -> [Focus] -> Maybe [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Focus -> Maybe Bool
focusToMaybeBool (Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t) of
        Just [Bool]
bs -> Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
op [Bool]
bs)
        Maybe [Bool]
Nothing -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus

focusNot :: Focuser
focusNot :: Focuser
focusNot = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus ->
    case Focus -> Maybe Bool
focusToMaybeBool Focus
focus of
        Just Bool
b  -> Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b)
        Maybe Bool
Nothing -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus

focusConst :: Text -> Focuser
focusConst :: Text -> Focuser
focusConst Text
s = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus)
-> (Focus -> Focus -> Focus) -> Lens Focus Focus Focus Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Focus -> Focus -> Focus
forall a b. a -> b -> a
const (Focus -> Focus -> Focus) -> Focus -> Focus -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Focus
FText Text
s) Focus -> Focus -> Focus
forall a b. a -> b -> a
const

focusCompOrd :: (forall a . (Ord a, Eq a) => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompOrd :: (forall a. (Ord a, Eq a) => a -> a -> Bool)
-> Focuser -> Focuser -> Focuser
focusCompOrd forall a. (Ord a, Eq a) => a -> a -> Bool
op (FTrav Traversal' Focus Focus
t1) (FTrav Traversal' Focus Focus
t2) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus ->
    case (Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t1, Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t2) of
    ([FText Text
s1], [FText Text
s2]) -> case (Text -> Maybe Rational
readMaybeRational Text
s1, Text -> Maybe Rational
readMaybeRational Text
s2) of
        (Just Rational
r1, Just Rational
r2) -> Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
op Rational
r1 Rational
r2)
        (Maybe Rational, Maybe Rational)
_                  -> Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
forall a. (Ord a, Eq a) => a -> a -> Bool
op Text
s1 Text
s2)
    ([Focus], [Focus])
_ -> Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus

focusCompEq :: (forall a . Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq :: (forall a. Eq a => a -> a -> Bool) -> Focuser -> Focuser -> Focuser
focusCompEq forall a. Eq a => a -> a -> Bool
op (FTrav Traversal' Focus Focus
t1) (FTrav Traversal' Focus Focus
t2) = Traversal' Focus Focus -> Focuser
FTrav (Traversal' Focus Focus -> Focuser)
-> Traversal' Focus Focus -> Focuser
forall a b. (a -> b) -> a -> b
$ \Focus -> f Focus
f Focus
focus ->
    case (Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t1, Focus
focus Focus -> Getting (Endo [Focus]) Focus Focus -> [Focus]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Focus]) Focus Focus
Traversal' Focus Focus
t2) of
    ([FText Text
s1], [FText Text
s2]) -> case (Text -> Maybe Rational
readMaybeRational Text
s1, Text -> Maybe Rational
readMaybeRational Text
s2) of
        (Just Rational
r1, Just Rational
r2) -> Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
op Rational
r1 Rational
r2)
        (Maybe Rational, Maybe Rational)
_                  -> Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
op Text
s1 Text
s2)
    ([FList [Focus]
lst1], [FList [Focus]
lst2]) ->
        Focus
focus Focus -> f Focus -> f Focus
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Focus -> f Focus
f (Focus -> f Focus) -> (Bool -> Focus) -> Bool -> f Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Focus
FText (Text -> Focus) -> (Bool -> Text) -> Bool -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
boolToText (Bool -> f Focus) -> Bool -> f Focus
forall a b. (a -> b) -> a -> b
$ ((Focus, Focus) -> Bool) -> [(Focus, Focus)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Focus -> Focus -> Bool) -> (Focus, Focus) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
op) ([(Focus, Focus)] -> Bool) -> [(Focus, Focus)] -> Bool
forall a b. (a -> b) -> a -> b
$ [Focus] -> [Focus] -> [(Focus, Focus)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Focus]
lst1 [Focus]
lst2)