{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE ViewPatterns       #-}
{-# LANGUAGE KindSignatures #-}

module Common(module Common) where

import           Control.Applicative        (empty, (<|>))
import           Control.Lens               (Lens', Traversal', lens, (^..))
import           Control.Loop               (numLoop)
import           Control.Monad              (forM_)
import           Control.Monad.ST.Strict    (ST, runST)
import           Data.Array.ST              (STUArray)
import qualified Data.Array.ST              as A
import           Data.Data                  (Data)
import           Data.List                  (nub, sort)
import           Data.List.Extra            (nubOrd)
import           Data.Ratio                 (denominator, numerator)
import           Data.STRef                 ()
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Data.Void                  (Void)
import           Text.Megaparsec            (Parsec, label)
import           Text.Megaparsec.Char       (space1)
import qualified Text.Megaparsec.Char.Lexer as L
import           Text.Read                  (readMaybe)

data Focus
    = FText !Text
    | FList ![Focus]
  deriving Typeable Focus
Typeable Focus =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Focus -> c Focus)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Focus)
-> (Focus -> Constr)
-> (Focus -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Focus))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Focus))
-> ((forall b. Data b => b -> b) -> Focus -> Focus)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r)
-> (forall u. (forall d. Data d => d -> u) -> Focus -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Focus -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Focus -> m Focus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Focus -> m Focus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Focus -> m Focus)
-> Data Focus
Focus -> Constr
Focus -> DataType
(forall b. Data b => b -> b) -> Focus -> Focus
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Focus -> u
forall u. (forall d. Data d => d -> u) -> Focus -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Focus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Focus -> c Focus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Focus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Focus)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Focus -> c Focus
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Focus -> c Focus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Focus
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Focus
$ctoConstr :: Focus -> Constr
toConstr :: Focus -> Constr
$cdataTypeOf :: Focus -> DataType
dataTypeOf :: Focus -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Focus)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Focus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Focus)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Focus)
$cgmapT :: (forall b. Data b => b -> b) -> Focus -> Focus
gmapT :: (forall b. Data b => b -> b) -> Focus -> Focus
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Focus -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Focus -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Focus -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Focus -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Focus -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Focus -> m Focus
Data

instance Show Focus where
    show :: Focus -> String
show (FText Text
str) = Text -> String
forall a. Show a => a -> String
show Text
str
    show (FList [Focus]
lst) = [Focus] -> String
forall a. Show a => a -> String
show [Focus]
lst

instance Eq Focus where
    (FText Text
str1) == :: Focus -> Focus -> Bool
== (FText Text
str2) = Text
str1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
str2
    (FList [Focus]
lst1) == (FList [Focus]
lst2) = [Focus]
lst1 [Focus] -> [Focus] -> Bool
forall a. Eq a => a -> a -> Bool
== [Focus]
lst2
    Focus
_ == Focus
_                       = Bool
False

toTextUnsafe :: Focus -> Text
toTextUnsafe :: Focus -> Text
toTextUnsafe (FText Text
str) = Text
str
toTextUnsafe Focus
_           = String -> Text
forall a. HasCallStack => String -> a
error String
"toText called on a non-FText"

toListUnsafe :: Focus -> [Focus]
toListUnsafe :: Focus -> [Focus]
toListUnsafe (FList [Focus]
lst) = [Focus]
lst
toListUnsafe Focus
_           = String -> [Focus]
forall a. HasCallStack => String -> a
error String
"toList called on a non-FText"

_toListUnsafe :: Lens' [Focus] Focus
_toListUnsafe :: Lens' [Focus] Focus
_toListUnsafe = ([Focus] -> Focus)
-> ([Focus] -> Focus -> [Focus]) -> Lens' [Focus] Focus
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens [Focus] -> Focus
FList (([Focus] -> Focus -> [Focus]) -> Lens' [Focus] Focus)
-> ([Focus] -> Focus -> [Focus]) -> Lens' [Focus] Focus
forall a b. (a -> b) -> a -> b
$ (Focus -> [Focus]) -> [Focus] -> Focus -> [Focus]
forall a b. a -> b -> a
const Focus -> [Focus]
toListUnsafe

newtype Focuser = FTrav (Traversal' Focus Focus)

composeFocusers :: Focuser -> Focuser -> Focuser
composeFocusers :: Focuser -> Focuser -> Focuser
composeFocusers (FTrav Traversal' Focus Focus
a) (FTrav Traversal' Focus Focus
b) = Traversal' Focus Focus -> Focuser
FTrav ((Focus -> f Focus) -> Focus -> f Focus
Traversal' Focus Focus
a ((Focus -> f Focus) -> Focus -> f 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
Traversal' Focus Focus
b)

foldFocusers :: [Focuser] -> Focuser
foldFocusers :: [Focuser] -> Focuser
foldFocusers = (Focuser -> Focuser -> Focuser) -> Focuser -> [Focuser] -> Focuser
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Focuser -> Focuser -> Focuser
composeFocusers (Traversal' Focus Focus -> Focuser
FTrav (Focus -> f Focus) -> Focus -> f Focus
forall a. a -> a
Traversal' Focus Focus
id)

type Action = Text -> Focuser -> IO ()

type Mapping = Focus -> Focus

foldMappings :: [Mapping] -> Mapping
foldMappings :: [Focus -> Focus] -> Focus -> Focus
foldMappings = ((Focus -> Focus) -> (Focus -> Focus) -> Focus -> Focus)
-> (Focus -> Focus) -> [Focus -> Focus] -> Focus -> Focus
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Focus -> Focus) -> (Focus -> Focus) -> Focus -> Focus)
-> (Focus -> Focus) -> (Focus -> Focus) -> Focus -> Focus
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Focus -> Focus) -> (Focus -> Focus) -> Focus -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) Focus -> Focus
forall a. a -> a
id

type Parser = Parsec Void Text

showRational :: Rational -> Text
showRational :: Rational -> Text
showRational Rational
n = if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
    then String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
n)
    else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
n) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
n))

data Range
    = RangeSingle !Int
    | RangeRange !(Maybe Int) !(Maybe Int)

getIndexes :: [Range] -> Int -> [Int]
getIndexes :: [Range] -> Int -> [Int]
getIndexes [Range]
ranges Int
len = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
nubOrd ([Int] -> [Int]) -> ([Range] -> [Int]) -> [Range] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> ([Range] -> [Int]) -> [Range] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> [Int]) -> [Range] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Range -> [Int]
getIndexes' (Range -> [Int]) -> (Range -> Range) -> Range -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Range
fixRange) ([Range] -> [Int]) -> [Range] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Range]
ranges
  where
    getIndexes' :: Range -> [Int]
getIndexes' (RangeSingle Int
i) = [Int
i]
    getIndexes' (RangeRange Maybe Int
mstart Maybe Int
mend) =
        case (Maybe Int
mstart, Maybe Int
mend) of
            (Just Int
start, Just Int
end) -> [Int
start .. Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            (Just Int
start, Maybe Int
Nothing)  -> [Int
start .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            (Maybe Int
Nothing, Just Int
end)    -> [Int
0 .. Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            (Maybe Int
Nothing, Maybe Int
Nothing)     -> [Int
0 .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

    fixRange :: Range -> Range
fixRange (RangeSingle Int
i) = Int -> Range
RangeSingle (Int -> Int
fixIndex Int
i)
    fixRange (RangeRange Maybe Int
mstart Maybe Int
mend) = Maybe Int -> Maybe Int -> Range
RangeRange
        (Int -> Int
fixIndex (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mstart) (Int -> Int
fixIndex (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mend)

    fixIndex :: Int -> Int
fixIndex Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int
0
        | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
len

ws :: Parser ()
ws :: Parser ()
ws = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
ws

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
ws

integer :: Parser Int
integer :: Parser Int
integer = String -> Parser Int -> Parser Int
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"integer" (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Int -> Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed Parser ()
ws Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

rational :: Parser Rational
rational :: Parser Rational
rational = Scientific -> Rational
forall a. Real a => a -> Rational
toRational (Scientific -> Rational)
-> ParsecT Void Text Identity Scientific -> Parser Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall a.
String
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"number" (ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Scientific
 -> ParsecT Void Text Identity Scientific)
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall a b. (a -> b) -> a -> b
$ Parser ()
-> ParsecT Void Text Identity Scientific
-> ParsecT Void Text Identity Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed Parser ()
ws ParsecT Void Text Identity Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
L.scientific)

mapText :: (Char -> a) -> Text -> [a]
mapText :: forall a. (Char -> a) -> Text -> [a]
mapText Char -> a
f = (Char -> [a] -> [a]) -> [a] -> Text -> [a]
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (\Char
c [a]
cs -> Char -> a
f Char
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
cs) []

unsort :: [Int] -> Int -> [Int]
unsort :: [Int] -> Int -> [Int]
unsort [Int]
is Int
isLen = (forall s. ST s [Int]) -> [Int]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [Int]) -> [Int])
-> (forall s. ST s [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ do
    STUArray s Int Int
is' <- (Int, Int) -> [Int] -> ST s (STUArray s Int Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
A.newListArray (Int
0, Int
isLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int]
is :: ST s (STUArray s Int Int)
    STUArray s Int Int
is'' <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
A.newArray (Int
0, Int
isLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0 :: ST s (STUArray s Int Int)
    Int -> Int -> (Int -> ST s ()) -> ST s ()
forall a (m :: * -> *).
(Num a, Ord a, Monad m) =>
a -> a -> (a -> m ()) -> m ()
numLoop Int
0 (Int
isLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        Int
j <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
A.readArray STUArray s Int Int
is' Int
i
        STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
A.writeArray STUArray s Int Int
is'' Int
j Int
i
    [Int] -> ST s [Int]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return []

makeFilteredText :: Int -> [Int] -> Text -> Text
makeFilteredText :: Int -> [Int] -> Text -> Text
makeFilteredText Int
maxLen [Int]
is Text
str = Int
-> ((Int, [Int]) -> Maybe (Char, (Int, [Int])))
-> (Int, [Int])
-> Text
forall a. Int -> (a -> Maybe (Char, a)) -> a -> Text
T.unfoldrN Int
maxLen (Int, [Int]) -> Maybe (Char, (Int, [Int]))
builder (Int
0, [Int]
is)
  where
    builder :: (Int, [Int]) -> Maybe (Char, (Int, [Int]))
    builder :: (Int, [Int]) -> Maybe (Char, (Int, [Int]))
builder (Int
_, [])     = Maybe (Char, (Int, [Int]))
forall a. Maybe a
Nothing
    builder (Int
n, Int
i : [Int]
is) = (Char, (Int, [Int])) -> Maybe (Char, (Int, [Int]))
forall a. a -> Maybe a
Just (HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
str Int
i, (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Int]
is))

focusTo :: Mapping -> Focuser
focusTo :: (Focus -> Focus) -> Focuser
focusTo Focus -> Focus
mapping = 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
mapping Focus -> Focus -> Focus
forall a b. a -> b -> a
const

mappingTo :: Focuser -> Mapping
mappingTo :: Focuser -> Focus -> Focus
mappingTo (FTrav Traversal' Focus Focus
trav) Focus
focus = case (Focus
focus, 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
_, [FText Text
str]) -> Text -> Focus
FText Text
str
    (Focus, [Focus])
_                      -> Focus
focus

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

readMaybeRational :: Text -> Maybe Rational
readMaybeRational :: Text -> Maybe Rational
readMaybeRational Text
s = (Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> Maybe Integer -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Integer
readMaybeInteger Text
s) Maybe Rational -> Maybe Rational -> Maybe Rational
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Rational) -> Maybe Double -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Double
readMaybeDouble Text
s)

readMaybeInteger :: Text -> Maybe Integer
readMaybeInteger :: Text -> Maybe Integer
readMaybeInteger = String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> (Text -> String) -> Text -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

readMaybeDouble :: Text -> Maybe Double
readMaybeDouble :: Text -> Maybe Double
readMaybeDouble = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double)
-> (Text -> String) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack