module Cornelis.Subscripts where

import           Cornelis.Offsets
import           Cornelis.Vim (getWindowCursor, getBufferLine, replaceInterval, setWindowCursor, reportError)
import           Data.Foldable (asum, foldl', for_)
import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Maybe (fromMaybe)
import           Data.Proxy
import qualified Data.Text as T
import           Data.Void (Void)
import           Neovim (Neovim)
import           Neovim.API.Text (vim_get_current_window, window_get_buffer)
import           Text.Megaparsec

type Parser = Parsec Void T.Text


data Flavor a
  = Digits a
  | Subscript a
  | Superscript a
  deriving (Flavor a -> Flavor a -> Bool
(Flavor a -> Flavor a -> Bool)
-> (Flavor a -> Flavor a -> Bool) -> Eq (Flavor a)
forall a. Eq a => Flavor a -> Flavor a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Flavor a -> Flavor a -> Bool
== :: Flavor a -> Flavor a -> Bool
$c/= :: forall a. Eq a => Flavor a -> Flavor a -> Bool
/= :: Flavor a -> Flavor a -> Bool
Eq, Eq (Flavor a)
Eq (Flavor a) =>
(Flavor a -> Flavor a -> Ordering)
-> (Flavor a -> Flavor a -> Bool)
-> (Flavor a -> Flavor a -> Bool)
-> (Flavor a -> Flavor a -> Bool)
-> (Flavor a -> Flavor a -> Bool)
-> (Flavor a -> Flavor a -> Flavor a)
-> (Flavor a -> Flavor a -> Flavor a)
-> Ord (Flavor a)
Flavor a -> Flavor a -> Bool
Flavor a -> Flavor a -> Ordering
Flavor a -> Flavor a -> Flavor a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Flavor a)
forall a. Ord a => Flavor a -> Flavor a -> Bool
forall a. Ord a => Flavor a -> Flavor a -> Ordering
forall a. Ord a => Flavor a -> Flavor a -> Flavor a
$ccompare :: forall a. Ord a => Flavor a -> Flavor a -> Ordering
compare :: Flavor a -> Flavor a -> Ordering
$c< :: forall a. Ord a => Flavor a -> Flavor a -> Bool
< :: Flavor a -> Flavor a -> Bool
$c<= :: forall a. Ord a => Flavor a -> Flavor a -> Bool
<= :: Flavor a -> Flavor a -> Bool
$c> :: forall a. Ord a => Flavor a -> Flavor a -> Bool
> :: Flavor a -> Flavor a -> Bool
$c>= :: forall a. Ord a => Flavor a -> Flavor a -> Bool
>= :: Flavor a -> Flavor a -> Bool
$cmax :: forall a. Ord a => Flavor a -> Flavor a -> Flavor a
max :: Flavor a -> Flavor a -> Flavor a
$cmin :: forall a. Ord a => Flavor a -> Flavor a -> Flavor a
min :: Flavor a -> Flavor a -> Flavor a
Ord, Int -> Flavor a -> ShowS
[Flavor a] -> ShowS
Flavor a -> String
(Int -> Flavor a -> ShowS)
-> (Flavor a -> String) -> ([Flavor a] -> ShowS) -> Show (Flavor a)
forall a. Show a => Int -> Flavor a -> ShowS
forall a. Show a => [Flavor a] -> ShowS
forall a. Show a => Flavor a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Flavor a -> ShowS
showsPrec :: Int -> Flavor a -> ShowS
$cshow :: forall a. Show a => Flavor a -> String
show :: Flavor a -> String
$cshowList :: forall a. Show a => [Flavor a] -> ShowS
showList :: [Flavor a] -> ShowS
Show, (forall a b. (a -> b) -> Flavor a -> Flavor b)
-> (forall a b. a -> Flavor b -> Flavor a) -> Functor Flavor
forall a b. a -> Flavor b -> Flavor a
forall a b. (a -> b) -> Flavor a -> Flavor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Flavor a -> Flavor b
fmap :: forall a b. (a -> b) -> Flavor a -> Flavor b
$c<$ :: forall a b. a -> Flavor b -> Flavor a
<$ :: forall a b. a -> Flavor b -> Flavor a
Functor)

extract :: Flavor a -> a
extract :: forall a. Flavor a -> a
extract (Digits a
a) = a
a
extract (Subscript a
a) = a
a
extract (Superscript a
a) = a
a

parseNum :: Num a => Flavor (Char, String) -> Parser (Flavor a)
parseNum :: forall a. Num a => Flavor (Char, String) -> Parser (Flavor a)
parseNum Flavor (Char, String)
f = do
  a
r <- (a -> a)
-> ParsecT Void Text Identity (a -> a)
-> ParsecT Void Text Identity (a -> a)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option a -> a
forall a. a -> a
id (a -> a
forall a. Num a => a -> a
negate (a -> a)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (a -> a)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Char, String) -> Char
forall a b. (a, b) -> a
fst (Flavor (Char, String) -> (Char, String)
forall a. Flavor a -> a
extract Flavor (Char, String)
f)) ) ParsecT Void Text Identity (a -> a)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flavor String -> ParsecT Void Text Identity a
forall a. Num a => Flavor String -> Parser a
parseDigits (((Char, String) -> String)
-> Flavor (Char, String) -> Flavor String
forall a b. (a -> b) -> Flavor a -> Flavor b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, String) -> String
forall a b. (a, b) -> b
snd Flavor (Char, String)
f)
  Flavor a -> Parser (Flavor a)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flavor a -> Parser (Flavor a)) -> Flavor a -> Parser (Flavor a)
forall a b. (a -> b) -> a -> b
$ a
r a -> Flavor (Char, String) -> Flavor a
forall a b. a -> Flavor b -> Flavor a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Flavor (Char, String)
f


parseDigits :: Num a => Flavor String -> Parser a
parseDigits :: forall a. Num a => Flavor String -> Parser a
parseDigits Flavor String
fv = Text -> a
mkNum (Text -> a)
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"digit") ((Token Text -> String -> Bool) -> String -> Token Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
Token Text -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Token Text -> Bool) -> String -> Token Text -> Bool
forall a b. (a -> b) -> a -> b
$ Flavor String -> String
forall a. Flavor a -> a
extract Flavor String
fv)
  where
    mkNum :: Text -> a
mkNum = (a -> Char -> a) -> a -> String -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Char -> a
forall {a}. Num a => a -> Char -> a
step a
0 (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Text -> Tokens Text -> [Token Text]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy Text
forall {k} (t :: k). Proxy t
Proxy :: Proxy T.Text)
    step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Flavor String -> Char -> Int
digitToInt Flavor String
fv Char
c)


digitToInt :: Flavor String -> Char -> Int
digitToInt :: Flavor String -> Char -> Int
digitToInt Flavor String
fv
  = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error String
"digitToInt: not a digit")
  (Maybe Int -> Int) -> (Char -> Maybe Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [(Char, Int)] -> Maybe Int)
-> [(Char, Int)] -> Char -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> [(Char, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Flavor String -> String
forall a. Flavor a -> a
extract Flavor String
fv) [Int
0..])


subscripts :: Flavor (Char, String)
subscripts :: Flavor (Char, String)
subscripts = (Char, String) -> Flavor (Char, String)
forall a. a -> Flavor a
Subscript (Char
'₋', String
"₀₁₂₃₄₅₆₇₈₉")


superscripts :: Flavor (Char, String)
superscripts :: Flavor (Char, String)
superscripts = (Char, String) -> Flavor (Char, String)
forall a. a -> Flavor a
Superscript (Char
'⁻', String
"⁰¹²³⁴⁵⁶⁷⁸⁹")


digits :: Flavor (Char, String)
digits :: Flavor (Char, String)
digits = (Char, String) -> Flavor (Char, String)
forall a. a -> Flavor a
Digits (Char
'-', String
"0123456789")


mkReplacement :: (Char, String) -> (Char, String) -> Map Char Char
mkReplacement :: (Char, String) -> (Char, String) -> Map Char Char
mkReplacement (Char
m1, String
s1) (Char
m2, String
s2) = [(Char, Char)] -> Map Char Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Char, Char)] -> Map Char Char)
-> [(Char, Char)] -> Map Char Char
forall a b. (a -> b) -> a -> b
$ String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Char
m1 Char -> ShowS
forall a. a -> [a] -> [a]
: String
s1) (Char
m2 Char -> ShowS
forall a. a -> [a] -> [a]
: String
s2)


replace :: Map Char Char -> String -> String
replace :: Map Char Char -> ShowS
replace Map Char Char
m = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
c (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Map Char Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c Map Char Char
m)


parseFlavor :: Parser (Flavor Int)
parseFlavor :: Parser (Flavor Int)
parseFlavor = [Parser (Flavor Int)] -> Parser (Flavor Int)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  [ Flavor (Char, String) -> Parser (Flavor Int)
forall a. Num a => Flavor (Char, String) -> Parser (Flavor a)
parseNum Flavor (Char, String)
digits
  , Flavor (Char, String) -> Parser (Flavor Int)
forall a. Num a => Flavor (Char, String) -> Parser (Flavor a)
parseNum Flavor (Char, String)
superscripts
  , Flavor (Char, String) -> Parser (Flavor Int)
forall a. Num a => Flavor (Char, String) -> Parser (Flavor a)
parseNum Flavor (Char, String)
subscripts
  ]

parseLine :: Parser (String, Flavor Int)
parseLine :: Parser (String, Flavor Int)
parseLine = ParsecT Void Text Identity Char
-> Parser (Flavor Int) -> Parser (String, Flavor Int)
forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
manyTill_ ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Parser (Flavor Int) -> Parser (String, Flavor Int))
-> Parser (Flavor Int) -> Parser (String, Flavor Int)
forall a b. (a -> b) -> a -> b
$ Parser (Flavor Int) -> Parser (Flavor Int)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Flavor Int)
parseFlavor


unparse :: Flavor Int -> String
unparse :: Flavor Int -> String
unparse (Digits Int
n) = (Char, String) -> Int -> String
unparseWith (Flavor (Char, String) -> (Char, String)
forall a. Flavor a -> a
extract Flavor (Char, String)
digits) Int
n
unparse (Subscript Int
n) = (Char, String) -> Int -> String
unparseWith (Flavor (Char, String) -> (Char, String)
forall a. Flavor a -> a
extract Flavor (Char, String)
subscripts) Int
n
unparse (Superscript Int
n) = (Char, String) -> Int -> String
unparseWith (Flavor (Char, String) -> (Char, String)
forall a. Flavor a -> a
extract Flavor (Char, String)
superscripts) Int
n

unparseWith :: (Char, String) -> Int -> String
unparseWith :: (Char, String) -> Int -> String
unparseWith (Char, String)
to Int
n =
  let from :: (Char, String)
from = Flavor (Char, String) -> (Char, String)
forall a. Flavor a -> a
extract Flavor (Char, String)
digits
      rep :: Map Char Char
rep = (Char, String) -> (Char, String) -> Map Char Char
mkReplacement (Char, String)
from (Char, String)
to
   in Map Char Char -> ShowS
replace Map Char Char
rep ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n


applyOver :: (Int -> Int) -> Parser (T.Text, (Int, Int))
applyOver :: (Int -> Int) -> Parser (Text, (Int, Int))
applyOver Int -> Int
f = do
  (String
start_str, Flavor Int
fv) <- Parser (String, Flavor Int)
parseLine
  let n :: String
n = Flavor Int -> String
unparse (Flavor Int -> String) -> Flavor Int -> String
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Flavor Int -> Flavor Int
forall a b. (a -> b) -> Flavor a -> Flavor b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
f Flavor Int
fv
      start :: Text
start = String -> Text
T.pack String
start_str
  (Text, (Int, Int)) -> Parser (Text, (Int, Int))
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( String -> Text
T.pack String
n
    , (Text -> Int
T.length Text
start, String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
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
$ Flavor Int -> Int
forall a. Flavor a -> a
extract Flavor Int
fv)
    )


incNextDigitSeq :: Neovim env ()
incNextDigitSeq :: forall env. Neovim env ()
incNextDigitSeq = (Int -> Int) -> Neovim env ()
forall env. (Int -> Int) -> Neovim env ()
overNextDigitSeq (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)


decNextDigitSeq :: Neovim env ()
decNextDigitSeq :: forall env. Neovim env ()
decNextDigitSeq = (Int -> Int) -> Neovim env ()
forall env. (Int -> Int) -> Neovim env ()
overNextDigitSeq (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)


overNextDigitSeq ::  (Int -> Int) -> Neovim env ()
overNextDigitSeq :: forall env. (Int -> Int) -> Neovim env ()
overNextDigitSeq Int -> Int
f = do
  Window
w <- Neovim env Window
forall env. Neovim env Window
vim_get_current_window
  Buffer
b <- Window -> Neovim env Buffer
forall env. Window -> Neovim env Buffer
window_get_buffer Window
w
  Pos Index 'Line 'OneIndexed
line Index 'CodePoint 'OneIndexed
col <- Window -> Neovim env (Pos 'CodePoint 'OneIndexed 'OneIndexed)
forall env.
Window -> Neovim env (Pos 'CodePoint 'OneIndexed 'OneIndexed)
getWindowCursor Window
w
  Text
txt <- Buffer -> LineNumber 'ZeroIndexed -> Neovim env Text
forall env. Buffer -> LineNumber 'ZeroIndexed -> Neovim env Text
getBufferLine Buffer
b (Index 'Line 'OneIndexed -> LineNumber 'ZeroIndexed
forall (e :: Unit). Index e 'OneIndexed -> Index e 'ZeroIndexed
zeroIndex Index 'Line 'OneIndexed
line)
  let later :: Text
later = Int -> Text -> Text
T.drop (Index 'CodePoint 'ZeroIndexed -> Int
forall a (e :: Unit). Num a => Index e 'ZeroIndexed -> a
fromZeroIndexed (Index 'CodePoint 'OneIndexed -> Index 'CodePoint 'ZeroIndexed
forall (e :: Unit). Index e 'OneIndexed -> Index e 'ZeroIndexed
zeroIndex Index 'CodePoint 'OneIndexed
col)) Text
txt

  Text -> Neovim env ()
forall env. Text -> Neovim env ()
reportError (Text -> Neovim env ()) -> Text -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
later
  Either (ParseErrorBundle Text Void) (Text, (Int, Int))
-> ((Text, (Int, Int)) -> Neovim env ()) -> Neovim env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Parser (Text, (Int, Int))
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (Text, (Int, Int))
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse ((Int -> Int) -> Parser (Text, (Int, Int))
applyOver Int -> Int
f) String
"" Text
later) (((Text, (Int, Int)) -> Neovim env ()) -> Neovim env ())
-> ((Text, (Int, Int)) -> Neovim env ()) -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ \(Text
result, (Int
before, Int
target)) ->  do
    Text -> Neovim env ()
forall env. Text -> Neovim env ()
reportError Text
result
    let start_col :: Index 'CodePoint 'OneIndexed
start_col = Index 'CodePoint 'OneIndexed
col Index 'CodePoint 'OneIndexed
-> Offset 'CodePoint -> Index 'CodePoint 'OneIndexed
forall (e :: Unit) (i :: Indexing).
Index e i -> Offset e -> Index e i
.+ Int -> Offset 'CodePoint
forall (e :: Unit). Int -> Offset e
Offset Int
before
        end_col :: Index 'CodePoint 'OneIndexed
end_col = Index 'CodePoint 'OneIndexed
start_col Index 'CodePoint 'OneIndexed
-> Offset 'CodePoint -> Index 'CodePoint 'OneIndexed
forall (e :: Unit) (i :: Indexing).
Index e i -> Offset e -> Index e i
.+ Int -> Offset 'CodePoint
forall (e :: Unit). Int -> Offset e
Offset Int
target
        start_pos :: Pos 'CodePoint 'OneIndexed 'OneIndexed
start_pos = Index 'Line 'OneIndexed
-> Index 'CodePoint 'OneIndexed
-> Pos 'CodePoint 'OneIndexed 'OneIndexed
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Index 'Line i -> Index e j -> Pos e i j
Pos Index 'Line 'OneIndexed
line Index 'CodePoint 'OneIndexed
start_col
        end_pos :: Pos 'CodePoint 'OneIndexed 'OneIndexed
end_pos = Index 'Line 'OneIndexed
-> Index 'CodePoint 'OneIndexed
-> Pos 'CodePoint 'OneIndexed 'OneIndexed
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Index 'Line i -> Index e j -> Pos e i j
Pos Index 'Line 'OneIndexed
line Index 'CodePoint 'OneIndexed
end_col

    Buffer
-> Interval (Pos 'CodePoint 'OneIndexed 'OneIndexed)
-> Text
-> Neovim env ()
forall env.
Buffer
-> Interval (Pos 'CodePoint 'OneIndexed 'OneIndexed)
-> Text
-> Neovim env ()
replaceInterval Buffer
b (Pos 'CodePoint 'OneIndexed 'OneIndexed
-> Pos 'CodePoint 'OneIndexed 'OneIndexed
-> Interval (Pos 'CodePoint 'OneIndexed 'OneIndexed)
forall p. p -> p -> Interval p
Interval Pos 'CodePoint 'OneIndexed 'OneIndexed
start_pos Pos 'CodePoint 'OneIndexed 'OneIndexed
end_pos) Text
result

    Window -> Pos 'CodePoint 'OneIndexed 'OneIndexed -> Neovim env ()
forall env.
Window -> Pos 'CodePoint 'OneIndexed 'OneIndexed -> Neovim env ()
setWindowCursor Window
w Pos 'CodePoint 'OneIndexed 'OneIndexed
start_pos