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

module Focusers where

import           Common               (Comparison (..), Evaluatable (..),
                                       Focus (..), Focuser (..), IfExpr (..),
                                       Mapping, Oper (..), Quantor (..),
                                       Range (RangeSingle), _toListUnsafe,
                                       composeFocusers, getIndexes,
                                       makeFilteredText, mapText, safeDiv,
                                       showScientific, toListUnsafe,
                                       toTextUnsafe, unsort)
import           Control.Lens         (lens, partsOf, (^..))
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.Scientific      (Scientific)
import           Data.Text            (Text)
import qualified Data.Text            as T
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
$ Scientific -> Text
showScientific (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Scientific) -> [Text] -> [Scientific]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Scientific
readMaybeScientific ([Text] -> [Scientific]) -> [Text] -> [Scientific]
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
$ Scientific -> Text
showScientific (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$
        (Char -> Maybe Scientific) -> [Char] -> [Scientific]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Scientific
readMaybeScientific (Text -> Maybe Scientific)
-> (Char -> Text) -> Char -> Maybe Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) ([Char] -> [Scientific]) -> [Char] -> [Scientific]
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
$ Scientific -> Text
showScientific (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Scientific) -> [Text] -> [Scientific]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Scientific
readMaybeScientific ([Text] -> [Scientific]) -> [Text] -> [Scientific]
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
$ Scientific -> Text
showScientific (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$
        (Char -> Maybe Scientific) -> [Char] -> [Scientific]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Scientific
readMaybeScientific (Text -> Maybe Scientific)
-> (Char -> Text) -> Char -> Maybe Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) ([Char] -> [Scientific]) -> [Char] -> [Scientific]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s

focusAverage :: Scientific -> Focuser
focusAverage :: Scientific -> Focuser
focusAverage Scientific
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 (Scientific -> Focus -> Focus
getAverage Scientific
n) Focus -> Focus -> Focus
forall a b. a -> b -> a
const

getAverage :: Scientific -> Focus -> Focus
getAverage :: Scientific -> Focus -> Focus
getAverage Scientific
n Focus
focus = case Focus
focus of
    FList [Focus]
_ -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Scientific -> Text
showScientific (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> [Scientific] -> Scientific
average Scientific
n ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Scientific) -> [Text] -> [Scientific]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Scientific
readMaybeScientific ([Text] -> [Scientific]) -> [Text] -> [Scientific]
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
$ Scientific -> Text
showScientific (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> [Scientific] -> Scientific
average Scientific
n ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$
        (Char -> Maybe Scientific) -> [Char] -> [Scientific]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe Scientific
readMaybeScientific (Text -> Maybe Scientific)
-> (Char -> Text) -> Char -> Maybe Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) ([Char] -> [Scientific]) -> [Char] -> [Scientific]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s

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

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

focusIf :: IfExpr -> Focuser
focusIf :: IfExpr -> Focuser
focusIf IfExpr
ifexpr = 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 -> if Focus
focus Focus -> IfExpr -> Bool
`passesIf` IfExpr
ifexpr
    then Focus -> f Focus
f Focus
focus
    else Focus -> f Focus
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
focus
  where
    passesIf :: Focus -> IfExpr -> Bool
    passesIf :: Focus -> IfExpr -> Bool
passesIf Focus
focus (IfAnd [IfExpr]
ifexprs) = (IfExpr -> Bool) -> [IfExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Focus -> IfExpr -> Bool
passesIf Focus
focus) [IfExpr]
ifexprs
    passesIf Focus
focus (IfOr [IfExpr]
ifexprs) = (IfExpr -> Bool) -> [IfExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Focus -> IfExpr -> Bool
passesIf Focus
focus) [IfExpr]
ifexprs
    passesIf Focus
focus (IfSingle Comparison
comp) =
        let op :: Oper
op = Comparison -> Oper
cmpOp Comparison
comp
            q1 :: Quantor
q1 = (Quantor, Evaluatable) -> Quantor
forall a b. (a, b) -> a
fst ((Quantor, Evaluatable) -> Quantor)
-> (Quantor, Evaluatable) -> Quantor
forall a b. (a -> b) -> a -> b
$ Comparison -> (Quantor, Evaluatable)
cmpLHS Comparison
comp
            q2 :: Quantor
q2 = (Quantor, Evaluatable) -> Quantor
forall a b. (a, b) -> a
fst ((Quantor, Evaluatable) -> Quantor)
-> (Quantor, Evaluatable) -> Quantor
forall a b. (a -> b) -> a -> b
$ Comparison -> (Quantor, Evaluatable)
cmpRHS Comparison
comp
            f1s :: [Either Scientific Focus]
f1s = Focus -> Evaluatable -> [Either Scientific Focus]
evaluateEval Focus
focus (Evaluatable -> [Either Scientific Focus])
-> Evaluatable -> [Either Scientific Focus]
forall a b. (a -> b) -> a -> b
$ (Quantor, Evaluatable) -> Evaluatable
forall a b. (a, b) -> b
snd ((Quantor, Evaluatable) -> Evaluatable)
-> (Quantor, Evaluatable) -> Evaluatable
forall a b. (a -> b) -> a -> b
$ Comparison -> (Quantor, Evaluatable)
cmpLHS Comparison
comp
            f2s :: [Either Scientific Focus]
f2s = Focus -> Evaluatable -> [Either Scientific Focus]
evaluateEval Focus
focus (Evaluatable -> [Either Scientific Focus])
-> Evaluatable -> [Either Scientific Focus]
forall a b. (a -> b) -> a -> b
$ (Quantor, Evaluatable) -> Evaluatable
forall a b. (a, b) -> b
snd ((Quantor, Evaluatable) -> Evaluatable)
-> (Quantor, Evaluatable) -> Evaluatable
forall a b. (a -> b) -> a -> b
$ Comparison -> (Quantor, Evaluatable)
cmpRHS Comparison
comp
            results :: [[Bool]]
results = [[Oper -> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOp Oper
op Either Scientific Focus
f1 Either Scientific Focus
f2 | Either Scientific Focus
f2 <- [Either Scientific Focus]
f2s] | Either Scientific Focus
f1 <- [Either Scientific Focus]
f1s]
        in case (Quantor
q1, Quantor
q2) of
            (Quantor
QAll, Quantor
QAll) -> ([Bool] -> Bool) -> [[Bool]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [[Bool]]
results
            (Quantor
QAll, Quantor
QAny) -> ([Bool] -> Bool) -> [[Bool]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[Bool]]
results
            (Quantor
QAny, Quantor
QAll) -> ([Bool] -> Bool) -> [[Bool]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [[Bool]]
results
            (Quantor
QAny, Quantor
QAny) -> ([Bool] -> Bool) -> [[Bool]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[Bool]]
results

    evaluateEval :: Focus -> Evaluatable -> [Either Scientific Focus]
    evaluateEval :: Focus -> Evaluatable -> [Either Scientific Focus]
evaluateEval Focus
focus Evaluatable
eval = case Evaluatable
eval of
        EText Text
s               -> [Focus -> Either Scientific Focus
forall a b. b -> Either a b
Right (Focus -> Either Scientific Focus)
-> Focus -> Either Scientific Focus
forall a b. (a -> b) -> a -> b
$ Text -> Focus
FText Text
s]
        ENumber Scientific
n             -> [Scientific -> Either Scientific Focus
forall a b. a -> Either a b
Left Scientific
n]
        EFocuser (FTrav Traversal' Focus Focus
trav) -> Focus -> Either Scientific Focus
forall a b. b -> Either a b
Right (Focus -> Either Scientific Focus)
-> [Focus] -> [Either Scientific Focus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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

    applyOp :: Oper -> Either Scientific Focus -> Either Scientific Focus -> Bool
    applyOp :: Oper -> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOp Oper
OpEq (Left Scientific
n1) (Left Scientific
n2) = Scientific
n1 Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
n2
    applyOp Oper
OpEq (Right Focus
f1) (Right Focus
f2) = Focus
f1 Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Focus
f2
    applyOp Oper
OpEq (Left Scientific
n1) (Right (FText Text
s2)) = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
n1 Maybe Scientific -> Maybe Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Scientific
readMaybeScientific Text
s2
    applyOp Oper
OpEq (Right (FText Text
s1)) (Left Scientific
n2) = Text -> Maybe Scientific
readMaybeScientific Text
s1 Maybe Scientific -> Maybe Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
n2
    applyOp Oper
OpNe (Left Scientific
n1) (Left Scientific
n2) = Scientific
n1 Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
/= Scientific
n2
    applyOp Oper
OpNe (Left Scientific
n1) (Right (FText Text
s2)) = case Text -> Maybe Scientific
readMaybeScientific Text
s2 of
        Just Scientific
n2 -> Scientific
n1 Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
/= Scientific
n2
        Maybe Scientific
Nothing -> Bool
False
    applyOp Oper
OpNe (Right (FText Text
s1)) (Left Scientific
n2) = case Text -> Maybe Scientific
readMaybeScientific Text
s1 of
        Just Scientific
n1 -> Scientific
n1 Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
/= Scientific
n2
        Maybe Scientific
Nothing -> Bool
False
    applyOp Oper
OpNe (Right Focus
f1) (Right Focus
f2) = Focus
f1 Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
/= Focus
f2
    applyOp Oper
op Either Scientific Focus
e1 Either Scientific Focus
e2 = case Oper
op of
        Oper
OpLt -> (forall a. Ord a => a -> a -> Bool)
-> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOpOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<) Either Scientific Focus
e1 Either Scientific Focus
e2
        Oper
OpGt -> (forall a. Ord a => a -> a -> Bool)
-> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOpOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) Either Scientific Focus
e1 Either Scientific Focus
e2
        Oper
OpLe -> (forall a. Ord a => a -> a -> Bool)
-> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOpOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Either Scientific Focus
e1 Either Scientific Focus
e2
        Oper
OpGe -> (forall a. Ord a => a -> a -> Bool)
-> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOpOrd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Either Scientific Focus
e1 Either Scientific Focus
e2
        Oper
_    -> Bool
False
      where
        applyOpOrd
            :: (forall a. Ord a => a -> a -> Bool)
            -> Either Scientific Focus
            -> Either Scientific Focus
            -> Bool
        applyOpOrd :: (forall a. Ord a => a -> a -> Bool)
-> Either Scientific Focus -> Either Scientific Focus -> Bool
applyOpOrd forall a. Ord a => a -> a -> Bool
f (Left Scientific
n1) (Left Scientific
n2) = Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
f Scientific
n1 Scientific
n2
        applyOpOrd forall a. Ord a => a -> a -> Bool
f (Left Scientific
n1) (Right (FText Text
s2)) = case Text -> Maybe Scientific
readMaybeScientific Text
s2 of
            Just Scientific
n2 -> Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
f Scientific
n1 Scientific
n2
            Maybe Scientific
Nothing -> Bool
False
        applyOpOrd forall a. Ord a => a -> a -> Bool
f (Right (FText Text
s1)) (Left Scientific
n2) = case Text -> Maybe Scientific
readMaybeScientific Text
s1 of
            Just Scientific
n1 -> Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
f Scientific
n1 Scientific
n2
            Maybe Scientific
Nothing -> Bool
False
        applyOpOrd forall a. Ord a => a -> a -> Bool
f (Right (FText Text
s1)) (Right (FText Text
s2)) =
            case (Text -> Maybe Scientific
readMaybeScientific Text
s1, Text -> Maybe Scientific
readMaybeScientific Text
s2) of
                (Just Scientific
n1, Just Scientific
n2) -> Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
f Scientific
n1 Scientific
n2
                (Maybe Scientific, Maybe Scientific)
_                  -> Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
f Text
s1 Text
s2
        applyOpOrd forall a. Ord a => a -> a -> Bool
_ Either Scientific Focus
_ Either Scientific Focus
_ = Bool
False

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)

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
  where
    fromIndexes :: Int -> Text -> [(Int, Int)] -> ([Text], [Text])
    fromIndexes :: Int -> Text -> [(Int, Int)] -> ([Text], [Text])
fromIndexes Int
_ Text
str [] = ([Text
str], [])
    fromIndexes Int
offset Text
str ((Int
i, Int
j) : [(Int, Int)]
is) =
        let (Text
nonMatch, Int -> Text -> (Text, Text)
T.splitAt Int
j -> (Text
match, Text
str')) = Int -> Text -> (Text, Text)
T.splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) Text
str
            ([Text]
nonMatches, [Text]
matches) = Int -> Text -> [(Int, Int)] -> ([Text], [Text])
fromIndexes (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) Text
str' [(Int, Int)]
is
        in  (Text
nonMatch Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
nonMatches, Text
match Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
matches)


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

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
    FText Text
s          -> 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 -> 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 -> f Focus) -> Text -> f 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)