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

module Mappings where

import           Common        (Focus (FList, FText), Focuser (..), Mapping,
                                Range, getIndexes, makeFilteredText, mapText,
                                readMaybeRational, showRational, toTextUnsafe)
import           Control.Lens  ((^..))
import           Data.Char     (toLower, toUpper)
import           Data.Function (on)
import           Data.List     (sortBy)
import           Data.Text     (Text)
import qualified Data.Text     as T
import           Text.Read     (readMaybe)

mappingReverse :: Mapping
mappingReverse :: Mapping
mappingReverse (FList [Focus]
lst) = [Focus] -> Focus
FList ([Focus] -> [Focus]
forall a. [a] -> [a]
reverse [Focus]
lst)
mappingReverse (FText Text
str) = Text -> Focus
FText (Text -> Text
T.reverse Text
str)

mappingLength :: Mapping
mappingLength :: Mapping
mappingLength (FText Text
str) = Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
str
mappingLength Focus
flist       = Focus
flist

mappingMap :: Mapping -> Mapping
mappingMap :: Mapping -> Mapping
mappingMap Mapping
mapping (FList [Focus]
lst) = [Focus] -> Focus
FList ([Focus] -> Focus) -> [Focus] -> Focus
forall a b. (a -> b) -> a -> b
$ Mapping -> [Focus] -> [Focus]
forall a b. (a -> b) -> [a] -> [b]
map Mapping
mapping [Focus]
lst
mappingMap Mapping
mapping (FText Text
str) = Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Text) -> Text -> [Text]
forall a. (Char -> a) -> Text -> [a]
mapText
    (Focus -> Text
toTextUnsafe (Focus -> Text) -> (Char -> Focus) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mapping
mapping Mapping -> (Char -> Focus) -> Char -> 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) Text
str

mappingAppend :: Focuser -> Mapping
mappingAppend :: Focuser -> Mapping
mappingAppend (FTrav Traversal' Focus Focus
trav) fstr :: Focus
fstr@(FText Text
str) = case Focus
fstr 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
s] -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
str Text
s
    [Focus]
_         -> Focus
fstr
mappingAppend Focuser
_ Focus
flist            = Focus
flist

mappingPrepend :: Focuser -> Mapping
mappingPrepend :: Focuser -> Mapping
mappingPrepend (FTrav Traversal' Focus Focus
trav) fstr :: Focus
fstr@(FText Text
str) = case Focus
fstr 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
s] -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
s Text
str
    [Focus]
_         -> Focus
fstr
mappingPrepend Focuser
_ Focus
flist            = Focus
flist

mappingUpper :: Mapping
mappingUpper :: Mapping
mappingUpper (FText Text
str) = Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
str
mappingUpper Focus
flist       = Focus
flist

mappingLower :: Mapping
mappingLower :: Mapping
mappingLower (FText Text
str) = Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
str
mappingLower Focus
flist       = Focus
flist

mappingMath :: (Rational -> Rational) -> Mapping
mappingMath :: (Rational -> Rational) -> Mapping
mappingMath Rational -> Rational
f (FText Text
str) = case Text -> Maybe Rational
readMaybeRational Text
str of
    Maybe Rational
Nothing -> Text -> Focus
FText Text
str
    Just Rational
n  -> 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
f Rational
n
mappingMath Rational -> Rational
_ Focus
flist         = Focus
flist

mappingAdd :: Rational -> Mapping
mappingAdd :: Rational -> Mapping
mappingAdd = (Rational -> Rational) -> Mapping
mappingMath ((Rational -> Rational) -> Mapping)
-> (Rational -> Rational -> Rational) -> Rational -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+)

mappingSub :: Rational -> Mapping
mappingSub :: Rational -> Mapping
mappingSub = (Rational -> Rational) -> Mapping
mappingMath ((Rational -> Rational) -> Mapping)
-> (Rational -> Rational -> Rational) -> Rational -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> Rational -> Rational -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)

mappingMult :: Rational -> Mapping
mappingMult :: Rational -> Mapping
mappingMult = (Rational -> Rational) -> Mapping
mappingMath ((Rational -> Rational) -> Mapping)
-> (Rational -> Rational -> Rational) -> Rational -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*)

mappingDiv :: Rational -> Mapping
mappingDiv :: Rational -> Mapping
mappingDiv = (Rational -> Rational) -> Mapping
mappingMath ((Rational -> Rational) -> Mapping)
-> (Rational -> Rational -> Rational) -> Rational -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> Rational -> Rational -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/)

mappingPow :: Int -> Mapping
mappingPow :: Int -> Mapping
mappingPow = (Rational -> Rational) -> Mapping
mappingMath ((Rational -> Rational) -> Mapping)
-> (Int -> Rational -> Rational) -> Int -> Mapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Int -> Rational) -> Int -> Rational -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
(^^)

mappingAbs :: Mapping
mappingAbs :: Mapping
mappingAbs = (Rational -> Rational) -> Mapping
mappingMath Rational -> Rational
forall a. Num a => a -> a
abs

mappingSign :: Mapping
mappingSign :: Mapping
mappingSign = (Rational -> Rational) -> Mapping
mappingMath Rational -> Rational
forall a. Num a => a -> a
signum

mappingSlice :: [Range] -> Mapping
mappingSlice :: [Range] -> Mapping
mappingSlice [Range]
ranges (FText Text
str) = Text -> Focus
FText Text
filtered_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

mappingSlice [Range]
_ Focus
flist = Focus
flist

mappingSortBy :: Focuser -> Mapping
mappingSortBy :: Focuser -> Mapping
mappingSortBy (FTrav Traversal' Focus Focus
trav) Focus
focus = case Focus
focus of
    FText Text
str -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Ordering) -> String -> String
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Focus -> Focus -> Ordering
cmp (Focus -> Focus -> Ordering)
-> (Char -> Focus) -> Char -> Char -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text -> Focus
FText (Text -> Focus) -> (Char -> Text) -> Char -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton)) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str
    FList [Focus]
lst   -> [Focus] -> Focus
FList ([Focus] -> Focus) -> [Focus] -> Focus
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus -> Ordering) -> [Focus] -> [Focus]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Focus -> Focus -> Ordering
cmp [Focus]
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

    readMDouble :: Text -> Maybe Double
    readMDouble :: Text -> Maybe Double
readMDouble = 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

mappingSortLexBy :: Focuser -> Mapping
mappingSortLexBy :: Focuser -> Mapping
mappingSortLexBy (FTrav Traversal' Focus Focus
trav) Focus
focus = case Focus
focus of
    FText Text
str -> Text -> Focus
FText (Text -> Focus) -> Text -> Focus
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Ordering) -> String -> String
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Focus -> Focus -> Ordering
cmp (Focus -> Focus -> Ordering)
-> (Char -> Focus) -> Char -> Char -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text -> Focus
FText (Text -> Focus) -> (Char -> Text) -> Char -> Focus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton)) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str
    FList [Focus]
lst   -> [Focus] -> Focus
FList ([Focus] -> Focus) -> [Focus] -> Focus
forall a b. (a -> b) -> a -> b
$ (Focus -> Focus -> Ordering) -> [Focus] -> [Focus]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Focus -> Focus -> Ordering
cmp [Focus]
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

mappingId :: Mapping
mappingId :: Mapping
mappingId = Mapping
forall a. a -> a
id