module Proteome.Tags.Mappings where

import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
import Exon (exon)
import Path (Abs, File, Path)
import Path.IO (doesFileExist)
import Ribosome (Rpc)
import Ribosome.Api (parseNvimFile)
import Ribosome.Host.Data.Report (ReportLog)
import qualified Ribosome.Menu as Menu
import Ribosome.Menu (Mappings, MenuWidget, menuOk, menuState, withFocus', (%=))
import qualified Ribosome.Menu.Data.MenuAction as MenuAction
import Ribosome.Menu.MenuState (mode)
import qualified Ribosome.Report as Report

import Proteome.Tags.State (Tag (Tag, line, path), TagsState, cycle)

data TagsAction =
  Navigate (Path Abs File) Int
  deriving stock (TagsAction -> TagsAction -> Bool
(TagsAction -> TagsAction -> Bool)
-> (TagsAction -> TagsAction -> Bool) -> Eq TagsAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagsAction -> TagsAction -> Bool
$c/= :: TagsAction -> TagsAction -> Bool
== :: TagsAction -> TagsAction -> Bool
$c== :: TagsAction -> TagsAction -> Bool
Eq, Int -> TagsAction -> ShowS
[TagsAction] -> ShowS
TagsAction -> String
(Int -> TagsAction -> ShowS)
-> (TagsAction -> String)
-> ([TagsAction] -> ShowS)
-> Show TagsAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagsAction] -> ShowS
$cshowList :: [TagsAction] -> ShowS
show :: TagsAction -> String
$cshow :: TagsAction -> String
showsPrec :: Int -> TagsAction -> ShowS
$cshowsPrec :: Int -> TagsAction -> ShowS
Show)

checkPath ::
  Members [Rpc, Embed IO] r =>
  Text ->
  Sem r (Maybe (Path Abs File))
checkPath :: forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
Text -> Sem r (Maybe (Path Abs File))
checkPath Text
path =
  MaybeT (Sem r) (Path Abs File) -> Sem r (Maybe (Path Abs File))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    Path Abs File
file <- Sem r (Maybe (Path Abs File)) -> MaybeT (Sem r) (Path Abs File)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Text -> Sem r (Maybe (Path Abs File))
forall (r :: EffectRow).
Member Rpc r =>
Text -> Sem r (Maybe (Path Abs File))
parseNvimFile Text
path)
    MaybeT (Sem r) Bool
-> MaybeT (Sem r) (Path Abs File)
-> MaybeT (Sem r) (Path Abs File)
-> MaybeT (Sem r) (Path Abs File)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Path Abs File -> MaybeT (Sem r) Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
file) (Path Abs File -> MaybeT (Sem r) (Path Abs File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
file) MaybeT (Sem r) (Path Abs File)
forall (f :: * -> *) a. Alternative f => f a
empty

navigate ::
  Members [Rpc, ReportLog, Embed IO] r =>
  MenuWidget TagsState r TagsAction
navigate :: forall (r :: EffectRow).
Members '[Rpc, ReportLog, Embed IO] r =>
MenuWidget TagsState r TagsAction
navigate =
  (Item TagsState
 -> Sem
      (Menu TagsState : Reader Prompt : r) (MenuAction TagsAction))
-> Sem
     (Menu TagsState : Reader Prompt : r)
     (Maybe (MenuAction TagsAction))
forall s (r :: EffectRow) a.
(MenuState s, Member (Menu s) r) =>
(Item s -> Sem r a) -> Sem r (Maybe a)
withFocus' \ Tag {Int
Text
line :: Int
path :: Text
$sel:path:Tag :: Tag -> Text
$sel:line:Tag :: Tag -> Int
..} ->
    Text
-> Sem (Menu TagsState : Reader Prompt : r) (Maybe (Path Abs File))
forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
Text -> Sem r (Maybe (Path Abs File))
checkPath Text
path Sem (Menu TagsState : Reader Prompt : r) (Maybe (Path Abs File))
-> (Maybe (Path Abs File)
    -> Sem
         (Menu TagsState : Reader Prompt : r) (MenuAction TagsAction))
-> Sem (Menu TagsState : Reader Prompt : r) (MenuAction TagsAction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Path Abs File
file ->
        MenuAction TagsAction
-> Sem (Menu TagsState : Reader Prompt : r) (MenuAction TagsAction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TagsAction -> MenuAction TagsAction
forall a. a -> MenuAction a
Menu.success (Path Abs File -> Int -> TagsAction
Navigate Path Abs File
file Int
line))
      Maybe (Path Abs File)
Nothing ->
        MenuAction TagsAction
forall a. MenuAction a
MenuAction.Continue MenuAction TagsAction
-> Sem (Menu TagsState : Reader Prompt : r) ()
-> Sem (Menu TagsState : Reader Prompt : r) (MenuAction TagsAction)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> [Text] -> Sem (Menu TagsState : Reader Prompt : r) ()
forall (r :: EffectRow).
Member ReportLog r =>
Text -> [Text] -> Sem r ()
Report.info [exon|File doesn't exist: #{path}|] [
          [exon|Tag file focused in menu doesn't exist: #{path}|]
          ]

cycleSegment :: MenuWidget TagsState r TagsAction
cycleSegment :: forall (r :: EffectRow). MenuWidget TagsState r TagsAction
cycleSegment =
  Sem
  (State (WithCursor TagsState) : Menu TagsState : Reader Prompt : r)
  (Maybe (MenuAction TagsAction))
-> Sem
     (Menu TagsState : Reader Prompt : r)
     (Maybe (MenuAction TagsAction))
forall s (r :: EffectRow).
Member (Menu s) r =>
InterpreterFor (State (WithCursor s)) r
menuState do
    (Mode (WithCursor TagsState)
 -> Identity (Mode (WithCursor TagsState)))
-> WithCursor TagsState -> Identity (WithCursor TagsState)
forall s. MenuState s => Lens' s (Mode s)
mode ((Mode (WithCursor TagsState)
  -> Identity (Mode (WithCursor TagsState)))
 -> WithCursor TagsState -> Identity (WithCursor TagsState))
-> ((Segment -> Identity Segment)
    -> Mode (WithCursor TagsState)
    -> Identity (Mode (WithCursor TagsState)))
-> (Segment -> Identity Segment)
-> WithCursor TagsState
-> Identity (WithCursor TagsState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "segment"
  ((Segment -> Identity Segment)
   -> Mode (WithCursor TagsState)
   -> Identity (Mode (WithCursor TagsState)))
(Segment -> Identity Segment)
-> Mode (WithCursor TagsState)
-> Identity (Mode (WithCursor TagsState))
#segment ((Segment -> Identity Segment)
 -> WithCursor TagsState -> Identity (WithCursor TagsState))
-> (Segment -> Segment)
-> Sem
     (State (WithCursor TagsState) : Menu TagsState : Reader Prompt : r)
     ()
forall s (r :: EffectRow) a b.
Member (State s) r =>
ASetter s s a b -> (a -> b) -> Sem r ()
%= Segment -> Segment
cycle
    Sem
  (State (WithCursor TagsState) : Menu TagsState : Reader Prompt : r)
  (Maybe (MenuAction TagsAction))
forall (r :: EffectRow) a. Sem r (Maybe (MenuAction a))
menuOk

mappings ::
  Members [Rpc, ReportLog, Embed IO] r =>
  Mappings TagsState r TagsAction
mappings :: forall (r :: EffectRow).
Members '[Rpc, ReportLog, Embed IO] r =>
Mappings TagsState r TagsAction
mappings =
  [(MappingSpec
"<cr>", MenuWidget TagsState r TagsAction
forall (r :: EffectRow).
Members '[Rpc, ReportLog, Embed IO] r =>
MenuWidget TagsState r TagsAction
navigate), (MappingSpec
"<c-s>", MenuWidget TagsState r TagsAction
forall (r :: EffectRow). MenuWidget TagsState r TagsAction
cycleSegment)]