module Proteome.Grep where

import Control.Lens (view)
import qualified Data.Text as Text
import Exon (exon)
import Path (Abs, Dir, File, Path)
import Ribosome (
  Args,
  Handler,
  Report,
  Rpc,
  RpcError,
  Scratch,
  ScratchId (ScratchId),
  Settings,
  mapReport,
  pathText,
  pluginLogReports,
  resumeReport,
  toMsgpack,
  unArgs,
  )
import Ribosome.Api (nvimCallFunction, nvimCommand, nvimDir)
import Ribosome.Api.Buffer (edit)
import Ribosome.Api.Path (nvimCwd)
import Ribosome.Api.Register (setregLine)
import Ribosome.Api.Window (setCurrentCursor)
import qualified Ribosome.Data.Register as Register (Register (Special))
import Ribosome.Data.ScratchOptions (ScratchOptions (..))
import Ribosome.Data.SettingError (SettingError)
import Ribosome.Menu (
  Filter (Fuzzy),
  Mappings,
  MenuItem,
  MenuWidget,
  ModalState,
  ModalWindowMenus,
  menuState,
  modal,
  windowMenu,
  withFocus,
  withSelection,
  )
import qualified Ribosome.Settings as Settings
import qualified Streamly.Internal.Data.Stream.IsStream as Stream
import Streamly.Prelude (IsStream, SerialT)

import Proteome.Data.Env (Env)
import Proteome.Data.GrepError (GrepError)
import qualified Proteome.Data.GrepError as GrepError (GrepError (EmptyUserInput))
import qualified Proteome.Data.GrepOutputLine as GrepOutputLine
import Proteome.Data.GrepOutputLine (GrepOutputLine (GrepOutputLine))
import Proteome.Data.ReplaceError (ReplaceError)
import Proteome.Grep.Process (defaultCmdline, grepCmdline, grepMenuItems)
import Proteome.Grep.Replace (deleteLines, replaceBuffer)
import Proteome.Grep.Syntax (grepSyntax)
import Proteome.Menu (handleResult)
import qualified Proteome.Settings as Settings (grepCmdline)

type GrepState =
  ModalState GrepOutputLine

data GrepAction =
  Select (Path Abs File) Int (Maybe Int)
  |
  Replace (NonEmpty GrepOutputLine)
  |
  Delete (NonEmpty GrepOutputLine)
  |
  NoAction
  deriving stock (GrepAction -> GrepAction -> Bool
(GrepAction -> GrepAction -> Bool)
-> (GrepAction -> GrepAction -> Bool) -> Eq GrepAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrepAction -> GrepAction -> Bool
$c/= :: GrepAction -> GrepAction -> Bool
== :: GrepAction -> GrepAction -> Bool
$c== :: GrepAction -> GrepAction -> Bool
Eq, Int -> GrepAction -> ShowS
[GrepAction] -> ShowS
GrepAction -> String
(Int -> GrepAction -> ShowS)
-> (GrepAction -> String)
-> ([GrepAction] -> ShowS)
-> Show GrepAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrepAction] -> ShowS
$cshowList :: [GrepAction] -> ShowS
show :: GrepAction -> String
$cshow :: GrepAction -> String
showsPrec :: Int -> GrepAction -> ShowS
$cshowsPrec :: Int -> GrepAction -> ShowS
Show)

navigate ::
  Member Rpc r =>
  Path Abs File ->
  Int ->
  Maybe Int ->
  Sem r ()
navigate :: forall (r :: EffectRow).
Member Rpc r =>
Path Abs File -> Int -> Maybe Int -> Sem r ()
navigate Path Abs File
path Int
line Maybe Int
col = do
  Path Abs File -> Sem r ()
forall (r :: EffectRow) b t. Member Rpc r => Path b t -> Sem r ()
edit Path Abs File
path
  Int -> Int -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Int -> Int -> Sem r ()
setCurrentCursor Int
line (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
col)
  Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
nvimCommand Text
"normal! zv"
  Text -> Sem r ()
forall (m :: * -> *). MonadRpc m => Text -> m ()
nvimCommand Text
"normal! zz"

selectResult ::
  MenuWidget GrepState r GrepAction
selectResult :: forall (r :: EffectRow). MenuWidget GrepState r GrepAction
selectResult = do
  (Item GrepState
 -> Sem (Menu GrepState : Reader Prompt : r) GrepAction)
-> MenuWidget GrepState r GrepAction
forall s (r :: EffectRow) a.
(MenuState s, Member (Menu s) r) =>
(Item s -> Sem r a) -> Sem r (Maybe (MenuAction a))
withFocus \ (GrepOutputLine Path Abs File
path Int
line Maybe Int
col Text
_) ->
    GrepAction -> Sem (Menu GrepState : Reader Prompt : r) GrepAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> Int -> Maybe Int -> GrepAction
Select Path Abs File
path Int
line Maybe Int
col)

yankResult ::
  Members [Rpc, Resource, Embed IO] r =>
  MenuWidget GrepState r GrepAction
yankResult :: forall (r :: EffectRow).
Members '[Rpc, Resource, Embed IO] r =>
MenuWidget GrepState r GrepAction
yankResult =
  (Item GrepState
 -> Sem (Menu GrepState : Reader Prompt : r) GrepAction)
-> Sem
     (Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall s (r :: EffectRow) a.
(MenuState s, Member (Menu s) r) =>
(Item s -> Sem r a) -> Sem r (Maybe (MenuAction a))
withFocus \ (GrepOutputLine Path Abs File
_ Int
_ Maybe Int
_ Text
txt) ->
    GrepAction
NoAction GrepAction
-> Sem (Menu GrepState : Reader Prompt : r) ()
-> Sem (Menu GrepState : Reader Prompt : r) GrepAction
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Register -> [Text] -> Sem (Menu GrepState : Reader Prompt : r) ()
forall (r :: EffectRow).
Member Rpc r =>
Register -> [Text] -> Sem r ()
setregLine (Text -> Register
Register.Special Text
"\"") [Text
Item [Text]
txt]

replaceResult ::
  MenuWidget GrepState r GrepAction
replaceResult :: forall (r :: EffectRow). MenuWidget GrepState r GrepAction
replaceResult =
  Sem
  (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
  (Maybe (MenuAction GrepAction))
-> Sem
     (Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall s (r :: EffectRow).
Member (Menu s) r =>
InterpreterFor (State (WithCursor s)) r
menuState (Sem
   (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
   (Maybe (MenuAction GrepAction))
 -> Sem
      (Menu GrepState : Reader Prompt : r)
      (Maybe (MenuAction GrepAction)))
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
-> Sem
     (Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Item GrepState)
 -> Sem
      (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
      GrepAction)
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall s (r :: EffectRow) a.
(MenuState s, Member (Menu s) r) =>
(NonEmpty (Item s) -> Sem r a) -> Sem r (Maybe (MenuAction a))
withSelection (GrepAction
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     GrepAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GrepAction
 -> Sem
      (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
      GrepAction)
-> (NonEmpty GrepOutputLine -> GrepAction)
-> NonEmpty GrepOutputLine
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     GrepAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GrepOutputLine -> GrepAction
Replace)

deleteResult ::
  MenuWidget GrepState r GrepAction
deleteResult :: forall (r :: EffectRow). MenuWidget GrepState r GrepAction
deleteResult =
  Sem
  (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
  (Maybe (MenuAction GrepAction))
-> Sem
     (Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall s (r :: EffectRow).
Member (Menu s) r =>
InterpreterFor (State (WithCursor s)) r
menuState (Sem
   (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
   (Maybe (MenuAction GrepAction))
 -> Sem
      (Menu GrepState : Reader Prompt : r)
      (Maybe (MenuAction GrepAction)))
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
-> Sem
     (Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Item GrepState)
 -> Sem
      (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
      GrepAction)
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     (Maybe (MenuAction GrepAction))
forall s (r :: EffectRow) a.
(MenuState s, Member (Menu s) r) =>
(NonEmpty (Item s) -> Sem r a) -> Sem r (Maybe (MenuAction a))
withSelection (GrepAction
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     GrepAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GrepAction
 -> Sem
      (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
      GrepAction)
-> (NonEmpty GrepOutputLine -> GrepAction)
-> NonEmpty GrepOutputLine
-> Sem
     (State (WithCursor GrepState) : Menu GrepState : Reader Prompt : r)
     GrepAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GrepOutputLine -> GrepAction
Delete)

menuItemSameLine :: MenuItem GrepOutputLine -> MenuItem GrepOutputLine -> Bool
menuItemSameLine :: MenuItem GrepOutputLine -> MenuItem GrepOutputLine -> Bool
menuItemSameLine MenuItem GrepOutputLine
l MenuItem GrepOutputLine
r =
  GrepOutputLine -> GrepOutputLine -> Bool
GrepOutputLine.sameLine (MenuItem GrepOutputLine
l MenuItem GrepOutputLine
-> Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine
-> GrepOutputLine
forall s a. s -> Getting a s a -> a
^. IsLabel
  "meta"
  (Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine)
Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine
#meta) (MenuItem GrepOutputLine
r MenuItem GrepOutputLine
-> Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine
-> GrepOutputLine
forall s a. s -> Getting a s a -> a
^. IsLabel
  "meta"
  (Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine)
Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine
#meta)

uniqBy ::
  Functor (t IO) =>
  IsStream t =>
  (a -> a -> Bool) ->
  t IO a ->
  t IO a
uniqBy :: forall (t :: (* -> *) -> * -> *) a.
(Functor (t IO), IsStream t) =>
(a -> a -> Bool) -> t IO a -> t IO a
uniqBy a -> a -> Bool
f =
  t IO (Maybe a) -> t IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m, Functor (t m)) =>
t m (Maybe a) -> t m a
Stream.catMaybes (t IO (Maybe a) -> t IO a)
-> (t IO a -> t IO (Maybe a)) -> t IO a -> t IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Maybe a -> a -> IO (Maybe a, Maybe a))
-> IO (Maybe a) -> t IO a -> t IO (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) s a b.
(IsStream t, Monad m) =>
(s -> a -> m (s, b)) -> m s -> t m a -> t m b
Stream.smapM ((a -> Maybe a -> IO (Maybe a, Maybe a))
-> Maybe a -> a -> IO (Maybe a, Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe a -> IO (Maybe a, Maybe a)
check) (Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
  where
    check :: a -> Maybe a -> IO (Maybe a, Maybe a)
check a
new =
      (Maybe a, Maybe a) -> IO (Maybe a, Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe a, Maybe a) -> IO (Maybe a, Maybe a))
-> (Maybe a -> (Maybe a, Maybe a))
-> Maybe a
-> IO (Maybe a, Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Just a
old | a -> a -> Bool
f a
old a
new ->
          (a -> Maybe a
forall a. a -> Maybe a
Just a
old, Maybe a
forall a. Maybe a
Nothing)
        Just a
_ ->
          (a -> Maybe a
forall a. a -> Maybe a
Just a
new, a -> Maybe a
forall a. a -> Maybe a
Just a
new)
        Maybe a
Nothing ->
          (a -> Maybe a
forall a. a -> Maybe a
Just a
new, a -> Maybe a
forall a. a -> Maybe a
Just a
new)

uniqueGrepLines ::
  Functor (t IO) =>
  IsStream t =>
  t IO (MenuItem GrepOutputLine) ->
  t IO (MenuItem GrepOutputLine)
uniqueGrepLines :: forall (t :: (* -> *) -> * -> *).
(Functor (t IO), IsStream t) =>
t IO (MenuItem GrepOutputLine) -> t IO (MenuItem GrepOutputLine)
uniqueGrepLines =
  (MenuItem GrepOutputLine -> MenuItem GrepOutputLine -> Bool)
-> t IO (MenuItem GrepOutputLine) -> t IO (MenuItem GrepOutputLine)
forall (t :: (* -> *) -> * -> *) a.
(Functor (t IO), IsStream t) =>
(a -> a -> Bool) -> t IO a -> t IO a
uniqBy MenuItem GrepOutputLine -> MenuItem GrepOutputLine -> Bool
menuItemSameLine

grepItems ::
  Members [Settings !! SettingError, Rpc, Stop GrepError, Log, Embed IO, Final IO] r =>
  Path Abs Dir ->
  Text ->
  [Text] ->
  Sem r (SerialT IO (MenuItem GrepOutputLine))
grepItems :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Rpc, Stop GrepError, Log, Embed IO,
    Final IO]
  r =>
Path Abs Dir
-> Text -> [Text] -> Sem r (SerialT IO (MenuItem GrepOutputLine))
grepItems Path Abs Dir
path Text
patt [Text]
opt = do
  Path Abs Dir
cwd <- Sem r (Path Abs Dir)
forall (m :: * -> *). MonadRpc m => m (Path Abs Dir)
nvimCwd
  Maybe Text
userCmd <- Setting Text -> Sem r (Maybe Text)
forall a (r :: EffectRow).
(MsgpackDecode a, Member (Settings !! SettingError) r) =>
Setting a -> Sem r (Maybe a)
Settings.maybe Setting Text
Settings.grepCmdline
  Text
grepper <- Sem r Text -> (Text -> Sem r Text) -> Maybe Text -> Sem r Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem r Text
forall (r :: EffectRow). Member (Embed IO) r => Sem r Text
defaultCmdline Text -> Sem r Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
userCmd
  (Path Abs File
exe, [Text]
args) <- Text
-> Text -> Path Abs Dir -> [Text] -> Sem r (Path Abs File, [Text])
forall (r :: EffectRow).
Members '[Stop GrepError, Embed IO] r =>
Text
-> Text -> Path Abs Dir -> [Text] -> Sem r (Path Abs File, [Text])
grepCmdline Text
grepper Text
patt Path Abs Dir
path [Text]
opt
  SerialT IO (MenuItem GrepOutputLine)
items <- Path Abs Dir
-> Path Abs File
-> [Text]
-> Sem r (SerialT IO (MenuItem GrepOutputLine))
forall (t :: (* -> *) -> * -> *) (r :: EffectRow).
(Functor (t IO), Members '[Log, Embed IO, Final IO] r,
 IsStream t) =>
Path Abs Dir
-> Path Abs File
-> [Text]
-> Sem r (t IO (MenuItem GrepOutputLine))
grepMenuItems Path Abs Dir
cwd Path Abs File
exe [Text]
args
  pure (SerialT IO (MenuItem GrepOutputLine)
-> SerialT IO (MenuItem GrepOutputLine)
forall (t :: (* -> *) -> * -> *).
(Functor (t IO), IsStream t) =>
t IO (MenuItem GrepOutputLine) -> t IO (MenuItem GrepOutputLine)
uniqueGrepLines SerialT IO (MenuItem GrepOutputLine)
items)

actions ::
  Members [Scratch, Rpc, Rpc !! RpcError, AtomicState Env, Stop ReplaceError, Resource, Embed IO] r =>
  Mappings GrepState r GrepAction
actions :: forall (r :: EffectRow).
Members
  '[Scratch, Rpc, Rpc !! RpcError, AtomicState Env,
    Stop ReplaceError, Resource, Embed IO]
  r =>
Mappings GrepState r GrepAction
actions =
  [
    (MappingSpec
"<cr>", MenuWidget GrepState r GrepAction
forall (r :: EffectRow). MenuWidget GrepState r GrepAction
selectResult),
    (MappingSpec
"y", MenuWidget GrepState r GrepAction
forall (r :: EffectRow).
Members '[Rpc, Resource, Embed IO] r =>
MenuWidget GrepState r GrepAction
yankResult),
    (MappingSpec
"r", MenuWidget GrepState r GrepAction
forall (r :: EffectRow). MenuWidget GrepState r GrepAction
replaceResult),
    (MappingSpec
"d", MenuWidget GrepState r GrepAction
forall (r :: EffectRow). MenuWidget GrepState r GrepAction
deleteResult)
  ]

grepAction ::
  Members [Scratch, Rpc, Rpc !! RpcError, AtomicState Env, Stop ReplaceError, Resource, Embed IO] r =>
  GrepAction ->
  Sem r ()
grepAction :: forall (r :: EffectRow).
Members
  '[Scratch, Rpc, Rpc !! RpcError, AtomicState Env,
    Stop ReplaceError, Resource, Embed IO]
  r =>
GrepAction -> Sem r ()
grepAction = \case
  Select Path Abs File
path Int
line Maybe Int
col ->
    Path Abs File -> Int -> Maybe Int -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Path Abs File -> Int -> Maybe Int -> Sem r ()
navigate Path Abs File
path Int
line Maybe Int
col
  Replace NonEmpty GrepOutputLine
results ->
    NonEmpty GrepOutputLine -> Sem r ()
forall (r :: EffectRow).
Members '[Scratch, Rpc, AtomicState Env] r =>
NonEmpty GrepOutputLine -> Sem r ()
replaceBuffer NonEmpty GrepOutputLine
results
  Delete NonEmpty GrepOutputLine
results ->
     [GrepOutputLine] -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>
[GrepOutputLine] -> Sem r ()
deleteLines (NonEmpty GrepOutputLine -> [GrepOutputLine]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GrepOutputLine
results)
  GrepAction
NoAction ->
    Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit

type GrepErrorStack =
  [Scratch, Settings, Rpc, Stop ReplaceError, Stop GrepError]

handleErrors ::
  Members [Settings !! SettingError, Scratch !! RpcError, Rpc !! RpcError, Stop Report] r =>
  InterpretersFor GrepErrorStack r
handleErrors :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Scratch !! RpcError, Rpc !! RpcError,
    Stop Report]
  r =>
InterpretersFor GrepErrorStack r
handleErrors =
  forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @GrepError (Sem (Stop GrepError : r) a -> Sem r a)
-> (Sem
      (Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError : r)
      a
    -> Sem (Stop GrepError : r) a)
-> Sem
     (Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @ReplaceError (Sem (Stop ReplaceError : Stop GrepError : r) a
 -> Sem (Stop GrepError : r) a)
-> (Sem
      (Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError : r)
      a
    -> Sem (Stop ReplaceError : Stop GrepError : r) a)
-> Sem
     (Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError : r)
     a
-> Sem (Stop GrepError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError : r)
  a
-> Sem (Stop ReplaceError : Stop GrepError : r) a
forall (r :: EffectRow).
Members
  '[Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError,
    Stop Report]
  r =>
InterpretersFor '[Scratch, Settings, Rpc] r
pluginLogReports

type GrepStack =
  [
    ModalWindowMenus () GrepOutputLine !! RpcError,
    Settings !! SettingError,
    Scratch !! RpcError,
    Rpc !! RpcError,
    AtomicState Env,
    Log,
    Resource,
    Embed IO,
    Final IO
  ]

grepWith ::
  Members GrepStack r =>
  Members GrepErrorStack r =>
  Member (Stop Report) r =>
  [Text] ->
  Path Abs Dir ->
  Text ->
  Sem r ()
grepWith :: forall (r :: EffectRow).
(Members GrepStack r, Members GrepErrorStack r,
 Member (Stop Report) r) =>
[Text] -> Path Abs Dir -> Text -> Sem r ()
grepWith [Text]
opt Path Abs Dir
path Text
patt =
  forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @RpcError do
    SerialT IO (MenuItem GrepOutputLine)
items <- Path Abs Dir
-> Text
-> [Text]
-> Sem (Stop RpcError : r) (SerialT IO (MenuItem GrepOutputLine))
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Rpc, Stop GrepError, Log, Embed IO,
    Final IO]
  r =>
Path Abs Dir
-> Text -> [Text] -> Sem r (SerialT IO (MenuItem GrepOutputLine))
grepItems Path Abs Dir
path Text
patt [Text]
opt
    MenuResult GrepAction
result <- SerialT IO (MenuItem (Item GrepState))
-> GrepState
-> WindowOptions
-> Mappings GrepState (Stop RpcError : r) GrepAction
-> Sem (Stop RpcError : r) (MenuResult GrepAction)
forall res result s (r :: EffectRow).
(MenuState s,
 Members
   '[UiMenus WindowConfig res s !! RpcError, Log, Stop RpcError] r) =>
SerialT IO (MenuItem (Item s))
-> s
-> WindowOptions
-> Mappings s r result
-> Sem r (MenuResult result)
windowMenu SerialT IO (MenuItem (Item GrepState))
SerialT IO (MenuItem GrepOutputLine)
items (Filter -> GrepState
forall mode i. mode -> Modal mode i
modal Filter
Fuzzy) (WindowOptions
forall a. Default a => a
def WindowOptions -> (WindowOptions -> WindowOptions) -> WindowOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "items"
  (ASetter WindowOptions WindowOptions ScratchOptions ScratchOptions)
ASetter WindowOptions WindowOptions ScratchOptions ScratchOptions
#items ASetter WindowOptions WindowOptions ScratchOptions ScratchOptions
-> ScratchOptions -> WindowOptions -> WindowOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScratchOptions
scratchOptions) Mappings GrepState (Stop RpcError : r) GrepAction
forall (r :: EffectRow).
Members
  '[Scratch, Rpc, Rpc !! RpcError, AtomicState Env,
    Stop ReplaceError, Resource, Embed IO]
  r =>
Mappings GrepState r GrepAction
actions
    (GrepAction -> Sem (Stop RpcError : r) ())
-> MenuResult GrepAction -> Sem (Stop RpcError : r) ()
forall (r :: EffectRow) a.
Members '[Rpc, Stop Report] r =>
(a -> Sem r ()) -> MenuResult a -> Sem r ()
handleResult GrepAction -> Sem (Stop RpcError : r) ()
forall (r :: EffectRow).
Members
  '[Scratch, Rpc, Rpc !! RpcError, AtomicState Env,
    Stop ReplaceError, Resource, Embed IO]
  r =>
GrepAction -> Sem r ()
grepAction MenuResult GrepAction
result
  where
    scratchOptions :: ScratchOptions
scratchOptions =
      ScratchOptions
forall a. Default a => a
def {
        $sel:name:ScratchOptions :: ScratchId
name = Text -> ScratchId
ScratchId Text
name,
        $sel:syntax:ScratchOptions :: [Syntax]
syntax = [Item [Syntax]
Syntax
grepSyntax],
        $sel:filetype:ScratchOptions :: Maybe Text
filetype = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
      }
    name :: Text
name =
      Text
"proteome-grep"

askUser ::
  Members [Rpc, Stop GrepError] r =>
  Text ->
  [Text] ->
  Sem r Text
askUser :: forall (r :: EffectRow).
Members '[Rpc, Stop GrepError] r =>
Text -> [Text] -> Sem r Text
askUser Text
purpose [Text]
args = do
  Text
spec <- Text -> [Object] -> Sem r Text
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> [Object] -> m a
nvimCallFunction Text
"input" (Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text -> Object) -> [Text] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [exon|#{purpose}: |] Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)
  if Text -> Bool
Text.null Text
spec then GrepError -> Sem r Text
forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (Text -> GrepError
GrepError.EmptyUserInput Text
purpose) else Text -> Sem r Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
spec

grepWithNative ::
  Members GrepStack r =>
  [Text] ->
  Maybe Text ->
  Maybe Args ->
  Handler r ()
grepWithNative :: forall (r :: EffectRow).
Members GrepStack r =>
[Text] -> Maybe Text -> Maybe Args -> Handler r ()
grepWithNative [Text]
opt Maybe Text
pathSpec Maybe Args
pattSpec = do
  Sem (Append GrepErrorStack (Stop Report : r)) () -> Handler r ()
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Scratch !! RpcError, Rpc !! RpcError,
    Stop Report]
  r =>
InterpretersFor GrepErrorStack r
handleErrors do
    Path Abs Dir
path <- Text
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     (Path Abs Dir)
forall (r :: EffectRow).
Members '[Rpc, Stop Report] r =>
Text -> Sem r (Path Abs Dir)
nvimDir (Text
 -> Sem
      (Scratch
         : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
         : r)
      (Path Abs Dir))
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     Text
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem
  (Scratch
     : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
     : r)
  Text
-> (Text
    -> Sem
         (Scratch
            : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
            : r)
         Text)
-> Maybe Text
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
-> [Text]
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     Text
forall (r :: EffectRow).
Members '[Rpc, Stop GrepError] r =>
Text -> [Text] -> Sem r Text
askUser Text
"directory" [Item [Text]
".", Item [Text]
"dir"]) Text
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
pathSpec
    Text
patt <- forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc (Sem
   (Rpc
      : Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError
      : Stop Report : r)
   Text
 -> Sem
      (Scratch
         : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
         : r)
      Text)
-> Sem
     (Rpc
        : Scratch : Settings : Rpc : Stop ReplaceError : Stop GrepError
        : Stop Report : r)
     Text
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     Text
forall a b. (a -> b) -> a -> b
$ forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @GrepError do
      Sem
  (Stop GrepError
     : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
     : Stop GrepError : Stop Report : r)
  Text
-> (Args
    -> Sem
         (Stop GrepError
            : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
            : Stop GrepError : Stop Report : r)
         Text)
-> Maybe Args
-> Sem
     (Stop GrepError
        : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
        : Stop GrepError : Stop Report : r)
     Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
-> [Text]
-> Sem
     (Stop GrepError
        : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
        : Stop GrepError : Stop Report : r)
     Text
forall (r :: EffectRow).
Members '[Rpc, Stop GrepError] r =>
Text -> [Text] -> Sem r Text
askUser Text
"pattern" []) (Text
-> Sem
     (Stop GrepError
        : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
        : Stop GrepError : Stop Report : r)
     Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
 -> Sem
      (Stop GrepError
         : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
         : Stop GrepError : Stop Report : r)
      Text)
-> (Args -> Text)
-> Args
-> Sem
     (Stop GrepError
        : Rpc : Scratch : Settings : Rpc : Stop ReplaceError
        : Stop GrepError : Stop Report : r)
     Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Text
unArgs) Maybe Args
pattSpec
    [Text]
-> Path Abs Dir
-> Text
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     ()
forall (r :: EffectRow).
(Members GrepStack r, Members GrepErrorStack r,
 Member (Stop Report) r) =>
[Text] -> Path Abs Dir -> Text -> Sem r ()
grepWith [Text]
opt Path Abs Dir
path Text
patt

proGrepIn ::
  Members GrepStack r =>
  Maybe Text ->
  Maybe Args ->
  Handler r ()
proGrepIn :: forall (r :: EffectRow).
Members GrepStack r =>
Maybe Text -> Maybe Args -> Handler r ()
proGrepIn =
  [Text] -> Maybe Text -> Maybe Args -> Handler r ()
forall (r :: EffectRow).
Members GrepStack r =>
[Text] -> Maybe Text -> Maybe Args -> Handler r ()
grepWithNative []

proGrepOpt ::
  Members GrepStack r =>
  Text ->
  Maybe Args ->
  Handler r ()
proGrepOpt :: forall (r :: EffectRow).
Members GrepStack r =>
Text -> Maybe Args -> Handler r ()
proGrepOpt Text
opt Maybe Args
patt = do
  Path Abs Dir
cwd <- forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc (Sem (Rpc : Stop Report : r) (Path Abs Dir)
 -> Sem (Stop Report : r) (Path Abs Dir))
-> Sem (Rpc : Stop Report : r) (Path Abs Dir)
-> Sem (Stop Report : r) (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @GrepError do
    Sem (Stop GrepError : Rpc : Stop Report : r) (Path Abs Dir)
forall (m :: * -> *). MonadRpc m => m (Path Abs Dir)
nvimCwd
  [Text] -> Maybe Text -> Maybe Args -> Handler r ()
forall (r :: EffectRow).
Members GrepStack r =>
[Text] -> Maybe Text -> Maybe Args -> Handler r ()
grepWithNative (Text -> [Text]
Text.words Text
opt) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Path Abs Dir -> Text
forall b t. Path b t -> Text
pathText Path Abs Dir
cwd)) Maybe Args
patt

proGrepOptIn ::
  Members GrepStack r =>
  Text ->
  Maybe Text ->
  Maybe Args ->
  Handler r ()
proGrepOptIn :: forall (r :: EffectRow).
Members GrepStack r =>
Text -> Maybe Text -> Maybe Args -> Handler r ()
proGrepOptIn Text
opt =
  [Text] -> Maybe Text -> Maybe Args -> Handler r ()
forall (r :: EffectRow).
Members GrepStack r =>
[Text] -> Maybe Text -> Maybe Args -> Handler r ()
grepWithNative (Text -> [Text]
Text.words Text
opt)

proGrep ::
  Members GrepStack r =>
  Maybe Args ->
  Handler r ()
proGrep :: forall (r :: EffectRow).
Members GrepStack r =>
Maybe Args -> Handler r ()
proGrep =
  Text -> Maybe Args -> Handler r ()
forall (r :: EffectRow).
Members GrepStack r =>
Text -> Maybe Args -> Handler r ()
proGrepOpt Text
""

proGrepList ::
  Members GrepStack r =>
  Text ->
  Maybe Text ->
  Maybe Text ->
  Handler r [GrepOutputLine]
proGrepList :: forall (r :: EffectRow).
Members GrepStack r =>
Text -> Maybe Text -> Maybe Text -> Handler r [GrepOutputLine]
proGrepList Text
patt Maybe Text
pathSpec Maybe Text
opt = do
  Path Abs Dir
path <- forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc (Text -> Sem (Rpc : Stop Report : r) (Path Abs Dir)
forall (r :: EffectRow).
Members '[Rpc, Stop Report] r =>
Text -> Sem r (Path Abs Dir)
nvimDir (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"." Maybe Text
pathSpec))
  SerialT IO (MenuItem GrepOutputLine)
items <- Sem
  (Append GrepErrorStack (Stop Report : r))
  (SerialT IO (MenuItem GrepOutputLine))
-> Sem (Stop Report : r) (SerialT IO (MenuItem GrepOutputLine))
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Scratch !! RpcError, Rpc !! RpcError,
    Stop Report]
  r =>
InterpretersFor GrepErrorStack r
handleErrors (Path Abs Dir
-> Text
-> [Text]
-> Sem
     (Scratch
        : Settings : Rpc : Stop ReplaceError : Stop GrepError : Stop Report
        : r)
     (SerialT IO (MenuItem GrepOutputLine))
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Rpc, Stop GrepError, Log, Embed IO,
    Final IO]
  r =>
Path Abs Dir
-> Text -> [Text] -> Sem r (SerialT IO (MenuItem GrepOutputLine))
grepItems Path Abs Dir
path Text
patt (Text -> [Text]
Text.words (Maybe Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
opt)))
  (MenuItem GrepOutputLine -> GrepOutputLine)
-> [MenuItem GrepOutputLine] -> [GrepOutputLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine
-> MenuItem GrepOutputLine -> GrepOutputLine
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
  "meta"
  (Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine)
Getting GrepOutputLine (MenuItem GrepOutputLine) GrepOutputLine
#meta) ([MenuItem GrepOutputLine] -> [GrepOutputLine])
-> Sem (Stop Report : r) [MenuItem GrepOutputLine]
-> Handler r [GrepOutputLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [MenuItem GrepOutputLine]
-> Sem (Stop Report : r) [MenuItem GrepOutputLine]
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (SerialT IO (MenuItem GrepOutputLine)
-> IO [MenuItem GrepOutputLine]
forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
Stream.toList SerialT IO (MenuItem GrepOutputLine)
items)