module Ribosome.Menu.Prompt.Data.Codes where

import Control.Exception.Lifted (try)
import Data.Map.Strict ((!?))
import qualified Data.Map.Strict as Map (fromList)
import qualified Data.Text as Text (singleton)

specialCodes :: Map Text Text
specialCodes :: Map Text Text
specialCodes =
  [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
    (Text
"\x80\xffX", Text
"c-@"),
    (Text
"\65533kb", Text
"bs"),
    (Text
"\x80kB", Text
"s-tab"),
    (Text
"\x0", Text
"c-k"),
    (Text
"\x80kD", Text
"del"),
    (Text
"\x9B", Text
"csi"),
    (Text
"\x80\xfdP", Text
"xcsi"),
    (Text
"\x80ku", Text
"up"),
    (Text
"\x80kd", Text
"down"),
    (Text
"\x80kl", Text
"left"),
    (Text
"\x80kr", Text
"right"),
    -- ("\x80\xfd", "s-up"),
    -- ("\x80\xfd", "s-down"),
    (Text
"\x80#4", Text
"s-left"),
    (Text
"\x80%i", Text
"s-right"),
    (Text
"\x80\xfdT", Text
"c-left"),
    (Text
"\x80\xfdU", Text
"c-right"),
    (Text
"\x80k1", Text
"f1"),
    (Text
"\x80k2", Text
"f2"),
    (Text
"\x80k3", Text
"f3"),
    (Text
"\x80k4", Text
"f4"),
    (Text
"\x80k5", Text
"f5"),
    (Text
"\x80k6", Text
"f6"),
    (Text
"\x80k7", Text
"f7"),
    (Text
"\x80k8", Text
"f8"),
    (Text
"\x80k9", Text
"f9"),
    (Text
"\x80k;", Text
"f10"),
    (Text
"\x80F1", Text
"f11"),
    (Text
"\x80F2", Text
"f12"),
    (Text
"\x80\xfd\x06", Text
"s-f1"),
    (Text
"\x80\xfd\x07", Text
"s-f2"),
    (Text
"\x80\xfd\x08", Text
"s-f3"),
    (Text
"\x80\xfd\x09", Text
"s-f4"),
    (Text
"\x80\xfd\x0A", Text
"s-f5"),
    (Text
"\x80\xfd\x0B", Text
"s-f6"),
    (Text
"\x80\xfd\x0C", Text
"s-f7"),
    (Text
"\x80\xfd\x0D", Text
"s-f8"),
    (Text
"\x80\xfd\x0E", Text
"s-f9"),
    (Text
"\x80\xfd\x0F", Text
"s-f10"),
    (Text
"\x80\xfd\x10", Text
"s-f11"),
    (Text
"\x80\xfd\x11", Text
"s-f12"),
    (Text
"\x80%1", Text
"help"),
    (Text
"\x80&8", Text
"undo"),
    (Text
"\x80kI", Text
"insert"),
    (Text
"\x80kh", Text
"home"),
    (Text
"\x80@7", Text
"end"),
    (Text
"\x80kP", Text
"pageup"),
    (Text
"\x80kN", Text
"pagedown"),
    (Text
"\x80K1", Text
"khome"),
    (Text
"\x80K4", Text
"kend"),
    (Text
"\x80K3", Text
"kpageup"),
    (Text
"\x80K5", Text
"kpagedown"),
    (Text
"\x80K6", Text
"kplus"),
    (Text
"\x80K7", Text
"kminus"),
    (Text
"\x80K9", Text
"kmultiply"),
    (Text
"\x80K8", Text
"kdivide"),
    (Text
"\x80KA", Text
"kenter"),
    (Text
"\x80KB", Text
"kpoint"),
    (Text
"\x80KC", Text
"k0"),
    (Text
"\x80KD", Text
"k1"),
    (Text
"\x80KE", Text
"k2"),
    (Text
"\x80KF", Text
"k3"),
    (Text
"\x80KG", Text
"k4"),
    (Text
"\x80KH", Text
"k5"),
    (Text
"\x80KI", Text
"k6"),
    (Text
"\x80KJ", Text
"k7"),
    (Text
"\x80KK", Text
"k8"),
    (Text
"\x80KL", Text
"k9")
    ]

specialNumCodes :: Map Int Text
specialNumCodes :: Map Int Text
specialNumCodes =
  [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
    (Int
9, Text
"tab"),
    (Int
10, Text
"c-j"),
    (Int
11, Text
"c-k"),
    (Int
12, Text
"fe"),
    (Int
13, Text
"cr"),
    (Int
14, Text
"c-n"),
    (Int
25, Text
"c-y"),
    (Int
27, Text
"esc"),
    (Int
32, Text
"space"),
    (Int
60, Text
"lt"),
    (Int
92, Text
"bslash"),
    (Int
124, Text
"bar")
    ]

modifierCodes :: [(Int, Text)]
modifierCodes :: [(Int, Text)]
modifierCodes =
  [
    (Int
2, Text
"shift"),
    (Int
4, Text
"control"),
    (Int
8, Text
"alt"),
    (Int
16, Text
"meta"),
    (Int
32, Text
"mouse_double"),
    (Int
64, Text
"mouse_triple"),
    (Int
96, Text
"mouse_quadruple"),
    (Int
128, Text
"command")
    ]

decodeInputChar :: Text -> Maybe Text
decodeInputChar :: Text -> Maybe Text
decodeInputChar =
  (Map Text Text
specialCodes Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!?)

decodeInputNum ::
  MonadBaseControl IO m =>
  Int ->
  m (Maybe Text)
decodeInputNum :: Int -> m (Maybe Text)
decodeInputNum Int
a =
  m (Maybe Text)
-> (Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Maybe Text)
codepoint (Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> m (Maybe Text))
-> (Text -> Maybe Text) -> Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) (Map Int Text
specialNumCodes Map Int Text -> Int -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
!? Int
a)
  where
    codepoint :: m (Maybe Text)
codepoint =
      (Char -> Text) -> Maybe Char -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton (Maybe Char -> Maybe Text)
-> (Either SomeException Char -> Maybe Char)
-> Either SomeException Char
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Either SomeException r -> Maybe r
forall l r. Either l r -> Maybe r
rightToMaybe @SomeException (Either SomeException Char -> Maybe Text)
-> m (Either SomeException Char) -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m (Either SomeException Char)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try (Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> m Char) -> Char -> m Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
a)