module Proteome.Tags.Cycle where

import qualified Data.List.NonEmpty.Zipper as Zipper
import Exon (exon)
import Log (Severity (Info))
import Path (Abs, File, Path)
import Ribosome (Args (Args), Report (Report), Rpc, toMsgpack, Handler, RpcError, resumeReport)
import Ribosome.Api (currentBufferPath, currentLine, nvimCallFunction)

import qualified Proteome.Data.CurrentTag as CurrentTag
import Proteome.Data.CurrentTag (pattern CurrentLoc, CurrentTag (CurrentTag), cycleLoc)
import Proteome.Data.Env (Env)
import Proteome.Tags.Nav (loadOrEdit)
import Proteome.Tags.Query (tagLocsPath)
import qualified Proteome.Tags.State as State
import Proteome.Tags.State (TagLoc (TagLoc))

nav ::
  Member Rpc r =>
  CurrentTag ->
  Sem r ()
nav :: forall (r :: EffectRow). Member Rpc r => CurrentTag -> Sem r ()
nav (CurrentLoc TagLoc {Int
Text
Path Abs File
$sel:line:TagLoc :: forall p. TagLoc p -> Int
$sel:path:TagLoc :: forall p. TagLoc p -> p
$sel:name:TagLoc :: forall p. TagLoc p -> Text
line :: Int
path :: Path Abs File
name :: Text
..}) =
  Path Abs File -> Int -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Path Abs File -> Int -> Sem r ()
loadOrEdit Path Abs File
path Int
line

continue ::
  Member Rpc r =>
  CurrentTag ->
  Text ->
  Sem r Bool
continue :: forall (r :: EffectRow).
Member Rpc r =>
CurrentTag -> Text -> Sem r Bool
continue CurrentTag {$sel:locations:CurrentTag :: CurrentTag -> Zipper (TagLoc (Path Abs File))
locations = Zipper (TagLoc (Path Abs File)) -> TagLoc (Path Abs File)
forall a. Zipper a -> a
Zipper.current -> TagLoc {Int
Text
Path Abs File
line :: Int
path :: Path Abs File
name :: Text
$sel:line:TagLoc :: forall p. TagLoc p -> Int
$sel:path:TagLoc :: forall p. TagLoc p -> p
$sel:name:TagLoc :: forall p. TagLoc p -> Text
..}} Text
newName = do
  Int
bufLine <- Sem r Int
forall (r :: EffectRow). Member Rpc r => Sem r Int
currentLine
  Maybe (Path Abs File)
bufPath <- Sem r (Maybe (Path Abs File))
forall (m :: * -> *). MonadRpc m => m (Maybe (Path Abs File))
currentBufferPath
  pure (Path Abs File -> Maybe (Path Abs File) -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Path Abs File
path Maybe (Path Abs File)
bufPath Bool -> Bool -> Bool
&& Int
bufLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line Bool -> Bool -> Bool
&& Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newName)

cycle ::
  Members [AtomicState (Maybe CurrentTag), Rpc] r =>
  CurrentTag ->
  Sem r ()
cycle :: forall (r :: EffectRow).
Members '[AtomicState (Maybe CurrentTag), Rpc] r =>
CurrentTag -> Sem r ()
cycle CurrentTag
cur = do
  Maybe CurrentTag -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut (CurrentTag -> Maybe CurrentTag
forall a. a -> Maybe a
Just CurrentTag
newCur)
  CurrentTag -> Sem r ()
forall (r :: EffectRow). Member Rpc r => CurrentTag -> Sem r ()
nav CurrentTag
newCur
  where
    newCur :: CurrentTag
newCur =
      CurrentTag
cur CurrentTag -> (CurrentTag -> CurrentTag) -> CurrentTag
forall a b. a -> (a -> b) -> b
& IsLabel
  "locations"
  (ASetter
     CurrentTag
     CurrentTag
     (Zipper (TagLoc (Path Abs File)))
     (Zipper (TagLoc (Path Abs File))))
ASetter
  CurrentTag
  CurrentTag
  (Zipper (TagLoc (Path Abs File)))
  (Zipper (TagLoc (Path Abs File)))
#locations ASetter
  CurrentTag
  CurrentTag
  (Zipper (TagLoc (Path Abs File)))
  (Zipper (TagLoc (Path Abs File)))
-> (Zipper (TagLoc (Path Abs File))
    -> Zipper (TagLoc (Path Abs File)))
-> CurrentTag
-> CurrentTag
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Zipper (TagLoc (Path Abs File)) -> Zipper (TagLoc (Path Abs File))
cycleLoc

storeAndNav ::
  Members [AtomicState (Maybe CurrentTag), Rpc] r =>
  Text ->
  NonEmpty (TagLoc (Path Abs File)) ->
  Sem r ()
storeAndNav :: forall (r :: EffectRow).
Members '[AtomicState (Maybe CurrentTag), Rpc] r =>
Text -> NonEmpty (TagLoc (Path Abs File)) -> Sem r ()
storeAndNav Text
name NonEmpty (TagLoc (Path Abs File))
locs = do
  Maybe CurrentTag -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
s -> Sem r ()
atomicPut (CurrentTag -> Maybe CurrentTag
forall a. a -> Maybe a
Just CurrentTag
cur)
  CurrentTag -> Sem r ()
forall (r :: EffectRow). Member Rpc r => CurrentTag -> Sem r ()
nav CurrentTag
cur
  where
    cur :: CurrentTag
cur =
      Text -> Zipper (TagLoc (Path Abs File)) -> CurrentTag
CurrentTag Text
name (NonEmpty (TagLoc (Path Abs File))
-> Zipper (TagLoc (Path Abs File))
forall a. NonEmpty a -> Zipper a
Zipper.fromNonEmpty NonEmpty (TagLoc (Path Abs File))
locs)

start ::
  Members [AtomicState (Maybe CurrentTag), AtomicState Env, Rpc, Stop Report, Embed IO] r =>
  Text ->
  Sem r ()
start :: forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc,
    Stop Report, Embed IO]
  r =>
Text -> Sem r ()
start Text
name = do
  Maybe (Path Abs File)
file <- Sem r (Maybe (Path Abs File))
forall (m :: * -> *). MonadRpc m => m (Maybe (Path Abs File))
currentBufferPath
  Maybe (NonEmpty (TagLoc (Path Abs File)))
tags <- [TagLoc (Path Abs File)]
-> Maybe (NonEmpty (TagLoc (Path Abs File)))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([TagLoc (Path Abs File)]
 -> Maybe (NonEmpty (TagLoc (Path Abs File))))
-> Sem r [TagLoc (Path Abs File)]
-> Sem r (Maybe (NonEmpty (TagLoc (Path Abs File))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
-> Maybe (Path Abs File) -> Sem r [TagLoc (Path Abs File)]
forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
Maybe Text
-> Maybe (Path Abs File) -> Sem r [TagLoc (Path Abs File)]
tagLocsPath (Text -> Maybe Text
forall a. a -> Maybe a
Just [exon|^#{name}$|]) Maybe (Path Abs File)
file
  Sem r ()
-> (NonEmpty (TagLoc (Path Abs File)) -> Sem r ())
-> Maybe (NonEmpty (TagLoc (Path Abs File)))
-> Sem r ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Report -> Sem r ()
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
err [Text
Item [Text]
err] Severity
Info)) (Text -> NonEmpty (TagLoc (Path Abs File)) -> Sem r ()
forall (r :: EffectRow).
Members '[AtomicState (Maybe CurrentTag), Rpc] r =>
Text -> NonEmpty (TagLoc (Path Abs File)) -> Sem r ()
storeAndNav Text
name) Maybe (NonEmpty (TagLoc (Path Abs File)))
tags
  where
    err :: Text
err =
      [exon|No matching tag for #{name}|]

nextTag ::
  Members [AtomicState (Maybe CurrentTag), AtomicState Env, Rpc, Stop Report, Embed IO] r =>
  Text ->
  Sem r ()
nextTag :: forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc,
    Stop Report, Embed IO]
  r =>
Text -> Sem r ()
nextTag Text
name =
  Sem r (Maybe CurrentTag)
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet Sem r (Maybe CurrentTag)
-> (Maybe CurrentTag -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just CurrentTag
cur ->
      Sem r Bool -> Sem r () -> Sem r () -> Sem r ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (CurrentTag -> Text -> Sem r Bool
forall (r :: EffectRow).
Member Rpc r =>
CurrentTag -> Text -> Sem r Bool
continue CurrentTag
cur Text
name) (CurrentTag -> Sem r ()
forall (r :: EffectRow).
Members '[AtomicState (Maybe CurrentTag), Rpc] r =>
CurrentTag -> Sem r ()
cycle CurrentTag
cur) (Text -> Sem r ()
forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc,
    Stop Report, Embed IO]
  r =>
Text -> Sem r ()
start Text
name)
    Maybe CurrentTag
Nothing ->
      Text -> Sem r ()
forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc,
    Stop Report, Embed IO]
  r =>
Text -> Sem r ()
start Text
name

cword ::
  Member Rpc r =>
  Sem r Text
cword :: forall (r :: EffectRow). Member Rpc r => Sem r Text
cword =
  Text -> [Object] -> Sem r Text
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
nvimCallFunction Text
"expand" [forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"<cword>"]

proNextTag ::
  Members [AtomicState (Maybe CurrentTag), AtomicState Env, Rpc !! RpcError, Embed IO] r =>
  Args ->
  Handler r ()
proNextTag :: forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc !! RpcError,
    Embed IO]
  r =>
Args -> Handler r ()
proNextTag =
  Sem (Rpc : Stop Report : r) () -> Sem (Stop Report : r) ()
forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport (Sem (Rpc : Stop Report : r) () -> Sem (Stop Report : r) ())
-> (Args -> Sem (Rpc : Stop Report : r) ())
-> Args
-> Sem (Stop Report : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Args Text
"" ->
      Text -> Sem (Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc,
    Stop Report, Embed IO]
  r =>
Text -> Sem r ()
nextTag (Text -> Sem (Rpc : Stop Report : r) ())
-> Sem (Rpc : Stop Report : r) Text
-> Sem (Rpc : Stop Report : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Rpc : Stop Report : r) Text
forall (r :: EffectRow). Member Rpc r => Sem r Text
cword
    Args Text
name ->
      Text -> Sem (Rpc : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[AtomicState (Maybe CurrentTag), AtomicState Env, Rpc,
    Stop Report, Embed IO]
  r =>
Text -> Sem r ()
nextTag Text
name