module Proteome.Files where
import Control.Lens (view)
import Control.Monad (foldM)
import Data.Either.Extra (eitherToMaybe)
import Data.List.Extra (dropEnd)
import qualified Data.List.NonEmpty as NonEmpty (toList, zip)
import Data.List.NonEmpty.Extra (maximumOn1)
import qualified Data.Text as Text
import Path (Abs, Dir, File, Path, Rel, parent, parseAbsDir, parseRelDir, parseRelFile, toFilePath, (</>))
import Path.IO (createDirIfMissing, doesDirExist, listDirRel)
import Ribosome (
Handler,
Report,
Rpc,
RpcError,
ScratchId (ScratchId),
SettingError,
Settings,
mapReport,
resumeReport,
)
import Ribosome.Api (nvimGetOption)
import Ribosome.Api.Buffer (edit)
import Ribosome.Api.Path (nvimCwd)
import Ribosome.Data.ScratchOptions (ScratchOptions (filetype, name, syntax))
import Ribosome.Data.Setting (Setting (Setting))
import Ribosome.Host.Data.Args (ArgList (ArgList))
import Ribosome.Menu (
Filter (Fuzzy),
Mappings,
MenuAction,
MenuWidget,
Prompt (..),
PromptConfig (OnlyInsert),
PromptMode,
PromptText (PromptText),
WindowMenus,
menuOk,
menuState,
menuSuccess,
menuUpdatePrompt,
modal,
windowMenu,
withSelection,
(%=),
)
import Ribosome.Menu.Mappings (insert, withInsert)
import Ribosome.Menu.MenuState (mode)
import qualified Ribosome.Settings as Settings
import Text.Regex.PCRE.Light (Regex, compileM)
import Proteome.Data.FilesConfig (FilesConfig (FilesConfig))
import Proteome.Data.FilesError (FilesError)
import qualified Proteome.Data.FilesError as FilesError (FilesError (..))
import qualified Proteome.Data.FilesState as FilesState
import Proteome.Data.FilesState (FilesMode (FilesMode), FilesState, Segment (Full), fileSegments)
import Proteome.Files.Source (files)
import Proteome.Files.Syntax (filesSyntax)
import Proteome.Menu (handleResult)
import qualified Proteome.Settings as Settings
data FileAction =
Create (Path Abs File)
|
Edit (NonEmpty (Path Abs File))
|
NoAction
deriving stock (FileAction -> FileAction -> Bool
(FileAction -> FileAction -> Bool)
-> (FileAction -> FileAction -> Bool) -> Eq FileAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileAction -> FileAction -> Bool
$c/= :: FileAction -> FileAction -> Bool
== :: FileAction -> FileAction -> Bool
$c== :: FileAction -> FileAction -> Bool
Eq, Int -> FileAction -> ShowS
[FileAction] -> ShowS
FileAction -> String
(Int -> FileAction -> ShowS)
-> (FileAction -> String)
-> ([FileAction] -> ShowS)
-> Show FileAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileAction] -> ShowS
$cshowList :: [FileAction] -> ShowS
show :: FileAction -> String
$cshow :: FileAction -> String
showsPrec :: Int -> FileAction -> ShowS
$cshowsPrec :: Int -> FileAction -> ShowS
Show)
editFile ::
MenuWidget FilesState r FileAction
editFile :: forall (r :: [(* -> *) -> * -> *]).
MenuWidget FilesState r FileAction
editFile =
(NonEmpty (Item FilesState)
-> Sem (Menu FilesState : Reader Prompt : r) FileAction)
-> Sem
(Menu FilesState : Reader Prompt : r)
(Maybe (MenuAction FileAction))
forall s (r :: [(* -> *) -> * -> *]) a.
(MenuState s, Member (Menu s) r) =>
(NonEmpty (Item s) -> Sem r a) -> Sem r (Maybe (MenuAction a))
withSelection (FileAction -> Sem (Menu FilesState : Reader Prompt : r) FileAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileAction
-> Sem (Menu FilesState : Reader Prompt : r) FileAction)
-> (NonEmpty (Item FilesState) -> FileAction)
-> NonEmpty (Item FilesState)
-> Sem (Menu FilesState : Reader Prompt : r) FileAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Path Abs File) -> FileAction
Edit (NonEmpty (Path Abs File) -> FileAction)
-> (NonEmpty (Item FilesState) -> NonEmpty (Path Abs File))
-> NonEmpty (Item FilesState)
-> FileAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item FilesState -> Path Abs File)
-> NonEmpty (Item FilesState) -> NonEmpty (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (Path Abs File) (Item FilesState) (Path Abs File)
-> Item FilesState -> Path Abs File
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
"path" (Getting (Path Abs File) (Item FilesState) (Path Abs File))
Getting (Path Abs File) (Item FilesState) (Path Abs File)
#path))
matchingDirs ::
Member (Embed IO) r =>
[Path Abs Dir] ->
Path Rel Dir ->
Sem r [Path Abs Dir]
matchingDirs :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> Path Rel Dir -> Sem r [Path Abs Dir]
matchingDirs [Path Abs Dir]
bases Path Rel Dir
path =
(Path Abs Dir -> Sem r Bool)
-> [Path Abs Dir] -> Sem r [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Either Text Bool -> Bool)
-> Sem r (Either Text Bool) -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either Text Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False) (Sem r (Either Text Bool) -> Sem r Bool)
-> (Path Abs Dir -> Sem r (Either Text Bool))
-> Path Abs Dir
-> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> Sem r (Either Text Bool)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (IO Bool -> Sem r (Either Text Bool))
-> (Path Abs Dir -> IO Bool)
-> Path Abs Dir
-> Sem r (Either Text Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist) ((Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
path) (Path Abs Dir -> Path Abs Dir) -> [Path Abs Dir] -> [Path Abs Dir]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Abs Dir]
bases)
dirsWithPrefix ::
Member (Embed IO) r =>
Text ->
Path Abs Dir ->
Sem r [Path Rel Dir]
dirsWithPrefix :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Text -> Path Abs Dir -> Sem r [Path Rel Dir]
dirsWithPrefix (Text -> Text
Text.toLower -> Text
prefix) Path Abs Dir
dir =
(Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Text.isPrefixOf Text
prefix (Text -> Bool) -> (Path Rel Dir -> Text) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Text) -> (Path Rel Dir -> Text) -> Path Rel Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> (Path Rel Dir -> String) -> Path Rel Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath) ([Path Rel Dir] -> [Path Rel Dir])
-> (([Path Rel Dir], [Path Rel File]) -> [Path Rel Dir])
-> ([Path Rel Dir], [Path Rel File])
-> [Path Rel Dir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path Rel Dir], [Path Rel File]) -> [Path Rel Dir]
forall a b. (a, b) -> a
fst (([Path Rel Dir], [Path Rel File]) -> [Path Rel Dir])
-> Sem r ([Path Rel Dir], [Path Rel File]) -> Sem r [Path Rel Dir]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> Sem r ([Path Rel Dir], [Path Rel File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path Abs Dir
dir
matchingPaths ::
Member (Embed IO) r =>
[Path Abs Dir] ->
Text ->
Sem r (Text, [Path Rel Dir])
matchingPaths :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> Text -> Sem r (Text, [Path Rel Dir])
matchingPaths [Path Abs Dir]
bases Text
text' =
(Text
subpath,) ([Path Rel Dir] -> (Text, [Path Rel Dir]))
-> ([[Path Rel Dir]] -> [Path Rel Dir])
-> [[Path Rel Dir]]
-> (Text, [Path Rel Dir])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Path Rel Dir]] -> [Path Rel Dir]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Path Rel Dir]] -> (Text, [Path Rel Dir]))
-> Sem r [[Path Rel Dir]] -> Sem r (Text, [Path Rel Dir])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Path Abs Dir -> Sem r [Path Rel Dir])
-> [Path Abs Dir] -> Sem r [[Path Rel Dir]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> Path Abs Dir -> Sem r [Path Rel Dir]
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Text -> Path Abs Dir -> Sem r [Path Rel Dir]
dirsWithPrefix Text
prefix) ([Path Abs Dir] -> Sem r [[Path Rel Dir]])
-> Sem r [Path Abs Dir] -> Sem r [[Path Rel Dir]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r [Path Abs Dir]
dirs)
where
subpath :: Text
subpath =
Text -> (Path Rel Dir -> Text) -> Maybe (Path Rel Dir) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> (Path Rel Dir -> String) -> Path Rel Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath) Maybe (Path Rel Dir)
dir
dirs :: Sem r [Path Abs Dir]
dirs =
Sem r [Path Abs Dir]
-> (Path Rel Dir -> Sem r [Path Abs Dir])
-> Maybe (Path Rel Dir)
-> Sem r [Path Abs Dir]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Path Abs Dir] -> Sem r [Path Abs Dir]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Path Abs Dir]
bases) ([Path Abs Dir] -> Path Rel Dir -> Sem r [Path Abs Dir]
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> Path Rel Dir -> Sem r [Path Abs Dir]
matchingDirs [Path Abs Dir]
bases) Maybe (Path Rel Dir)
dir
(Maybe (Path Rel Dir)
dir, Text
prefix) =
(Text -> Maybe (Path Rel Dir))
-> (Text, Text) -> (Maybe (Path Rel Dir), Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (String -> Maybe (Path Rel Dir))
-> (Text -> String) -> Text -> Maybe (Path Rel Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) ((Text, Text) -> (Maybe (Path Rel Dir), Text))
-> (Text, Text) -> (Maybe (Path Rel Dir), Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
Text.breakOnEnd Text
"/" Text
text'
commonPrefix :: [Text] -> Maybe Text
commonPrefix :: [Text] -> Maybe Text
commonPrefix (Text
h : [Text]
t) =
(Text -> Text -> Maybe Text) -> Text -> [Text] -> Maybe Text
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ Text
p Text
a -> Getting Text (Text, Text, Text) Text -> (Text, Text, Text) -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (Text, Text, Text) Text
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Text, Text, Text) -> Text)
-> Maybe (Text, Text, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe (Text, Text, Text)
Text.commonPrefixes Text
p Text
a) Text
h [Text]
t
commonPrefix [Text]
a =
[Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
a
tabComplete ::
Member (Embed IO) r =>
[Path Abs Dir] ->
Text ->
Sem r (Maybe Text)
tabComplete :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> Text -> Sem r (Maybe Text)
tabComplete [Path Abs Dir]
bases Text
promptText = do
[Path Abs Dir]
existingBases <- (Path Abs Dir -> Sem r Bool)
-> [Path Abs Dir] -> Sem r [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Path Abs Dir -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist [Path Abs Dir]
bases
(Text
subpath, [Path Rel Dir]
paths) <- [Path Abs Dir] -> Text -> Sem r (Text, [Path Rel Dir])
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> Text -> Sem r (Text, [Path Rel Dir])
matchingPaths [Path Abs Dir]
existingBases Text
promptText
Maybe Text -> Sem r (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
subpath (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe Text
commonPrefix (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> (Path Rel Dir -> String) -> Path Rel Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
forall b t. Path b t -> String
toFilePath (Path Rel Dir -> Text) -> [Path Rel Dir] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Rel Dir]
paths))
tabUpdatePrompt ::
PromptMode ->
Text ->
Prompt
tabUpdatePrompt :: PromptMode -> Text -> Prompt
tabUpdatePrompt PromptMode
st Text
prefix =
Int -> PromptMode -> PromptText -> Prompt
Prompt (Text -> Int
Text.length Text
prefix) PromptMode
st (Text -> PromptText
PromptText Text
prefix)
tab ::
Member (Embed IO) r =>
[Path Abs Dir] ->
MenuWidget FilesState r FileAction
tab :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> MenuWidget FilesState r FileAction
tab [Path Abs Dir]
bases = do
Prompt Int
_ PromptMode
promptState (PromptText Text
promptText) <- Sem (Menu FilesState : Reader Prompt : r) Prompt
forall i (r :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
Sem r i
ask
[Path Abs Dir]
-> Text -> Sem (Menu FilesState : Reader Prompt : r) (Maybe Text)
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> Text -> Sem r (Maybe Text)
tabComplete [Path Abs Dir]
bases Text
promptText Sem (Menu FilesState : Reader Prompt : r) (Maybe Text)
-> (Maybe Text -> MenuWidget FilesState r FileAction)
-> MenuWidget FilesState r FileAction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Text
prefix ->
Prompt -> MenuWidget FilesState r FileAction
forall (r :: [(* -> *) -> * -> *]) a. Prompt -> MenuActionSem r a
menuUpdatePrompt (PromptMode -> Text -> Prompt
tabUpdatePrompt PromptMode
promptState Text
prefix)
Maybe Text
Nothing ->
MenuWidget FilesState r FileAction
forall (r :: [(* -> *) -> * -> *]) a. Sem r (Maybe (MenuAction a))
menuOk
createAndEditFile ::
Members [Rpc, Stop FilesError, Embed IO] r =>
Path Abs File ->
Sem r ()
createAndEditFile :: forall (r :: [(* -> *) -> * -> *]).
Members '[Rpc, Stop FilesError, Embed IO] r =>
Path Abs File -> Sem r ()
createAndEditFile Path Abs File
path = do
(Text -> FilesError) -> IO () -> Sem r ()
forall e (r :: [(* -> *) -> * -> *]) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryAny (FilesError -> Text -> FilesError
forall a b. a -> b -> a
const FilesError
err) IO ()
create
Path Abs File -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) b t.
Member Rpc r =>
Path b t -> Sem r ()
edit Path Abs File
path
where
err :: FilesError
err =
Text -> FilesError
FilesError.CouldntCreateDir (String -> Text
forall a. ToText a => a -> Text
toText (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
dir))
create :: IO ()
create =
Bool -> Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True Path Abs Dir
dir
dir :: Path Abs Dir
dir =
Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
path
existingSubdirCount ::
Member (Embed IO) r =>
[Text] ->
Path Abs Dir ->
Sem r Int
existingSubdirCount :: forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Text] -> Path Abs Dir -> Sem r Int
existingSubdirCount =
Int -> [Text] -> Path Abs Dir -> Sem r Int
forall {f :: * -> *} {a} {a} {b}.
(ToString a, MonadIO f, Num a) =>
a -> [a] -> Path b Dir -> f a
loop Int
0
where
loop :: a -> [a] -> Path b Dir -> f a
loop a
count [] Path b Dir
_ =
a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
count
loop a
count (a
h : [a]
t) Path b Dir
dir =
case String -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (a -> String
forall a. ToString a => a -> String
toString a
h) of
Right Path Rel Dir
f ->
f Bool -> f a -> f a -> f a
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Path b Dir -> f Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path b Dir
sub) (a -> [a] -> Path b Dir -> f a
loop (a
count a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [a]
t Path b Dir
sub) (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
count)
where sub :: Path b Dir
sub = Path b Dir
dir Path b Dir -> Path Rel Dir -> Path b Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
f
Left SomeException
_ ->
a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
count
createFile ::
Member (Reader Prompt) r =>
Members [Stop FilesError, Embed IO] r =>
NonEmpty (Path Abs Dir) ->
Sem r (Maybe (MenuAction FileAction))
createFile :: forall (r :: [(* -> *) -> * -> *]).
(Member (Reader Prompt) r,
Members '[Stop FilesError, Embed IO] r) =>
NonEmpty (Path Abs Dir) -> Sem r (Maybe (MenuAction FileAction))
createFile NonEmpty (Path Abs Dir)
bases = do
PromptText Text
promptText <- Getting PromptText Prompt PromptText -> Prompt -> PromptText
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel "text" (Getting PromptText Prompt PromptText)
Getting PromptText Prompt PromptText
#text (Prompt -> PromptText) -> Sem r Prompt -> Sem r PromptText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r Prompt
forall i (r :: [(* -> *) -> * -> *]).
Member (Reader i) r =>
Sem r i
ask
let
parse :: NonEmpty Int -> Maybe (Path Abs File)
parse NonEmpty Int
counts =
(NonEmpty Int -> Path Abs Dir
base NonEmpty Int
counts Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (Path Rel File -> Path Abs File)
-> Maybe (Path Rel File) -> Maybe (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (Text -> String
forall a. ToString a => a -> String
toString Text
promptText)
NonEmpty Int
subdirCounts <- (Path Abs Dir -> Sem r Int)
-> NonEmpty (Path Abs Dir) -> Sem r (NonEmpty Int)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text] -> Path Abs Dir -> Sem r Int
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Text] -> Path Abs Dir -> Sem r Int
existingSubdirCount (Text -> [Text]
dirSegments Text
promptText)) NonEmpty (Path Abs Dir)
bases
Sem r (Maybe (MenuAction FileAction))
-> (Path Abs File -> Sem r (Maybe (MenuAction FileAction)))
-> Maybe (Path Abs File)
-> Sem r (Maybe (MenuAction FileAction))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Sem r (Maybe (MenuAction FileAction))
forall {a}. Text -> Sem r a
err Text
promptText) (FileAction -> Sem r (Maybe (MenuAction FileAction))
forall a (r :: [(* -> *) -> * -> *]).
a -> Sem r (Maybe (MenuAction a))
menuSuccess (FileAction -> Sem r (Maybe (MenuAction FileAction)))
-> (Path Abs File -> FileAction)
-> Path Abs File
-> Sem r (Maybe (MenuAction FileAction))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> FileAction
Create) (NonEmpty Int -> Maybe (Path Abs File)
parse NonEmpty Int
subdirCounts)
where
base :: NonEmpty Int -> Path Abs Dir
base NonEmpty Int
counts =
(Path Abs Dir, Int) -> Path Abs Dir
forall a b. (a, b) -> a
fst ((Path Abs Dir, Int) -> Path Abs Dir)
-> (Path Abs Dir, Int) -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ ((Path Abs Dir, Int) -> Int)
-> NonEmpty (Path Abs Dir, Int) -> (Path Abs Dir, Int)
forall b a. Ord b => (a -> b) -> NonEmpty a -> a
maximumOn1 (Path Abs Dir, Int) -> Int
forall a b. (a, b) -> b
snd (NonEmpty (Path Abs Dir)
-> NonEmpty Int -> NonEmpty (Path Abs Dir, Int)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty (Path Abs Dir)
bases NonEmpty Int
counts)
dirSegments :: Text -> [Text]
dirSegments =
Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
dropEnd Int
1 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"/"
err :: Text -> Sem r a
err =
FilesError -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Stop e) r =>
e -> Sem r a
stop (FilesError -> Sem r a) -> (Text -> FilesError) -> Text -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilesError
FilesError.InvalidFilePath
cycleSegment :: MenuWidget FilesState r FileAction
cycleSegment :: forall (r :: [(* -> *) -> * -> *]).
MenuWidget FilesState r FileAction
cycleSegment =
Sem
(State (WithCursor FilesState)
: Menu FilesState : Reader Prompt : r)
(Maybe (MenuAction FileAction))
-> Sem
(Menu FilesState : Reader Prompt : r)
(Maybe (MenuAction FileAction))
forall s (r :: [(* -> *) -> * -> *]).
Member (Menu s) r =>
InterpreterFor (State (WithCursor s)) r
menuState do
(Mode (WithCursor FilesState)
-> Identity (Mode (WithCursor FilesState)))
-> WithCursor FilesState -> Identity (WithCursor FilesState)
forall s. MenuState s => Lens' s (Mode s)
mode ((Mode (WithCursor FilesState)
-> Identity (Mode (WithCursor FilesState)))
-> WithCursor FilesState -> Identity (WithCursor FilesState))
-> ((Segment -> Identity Segment)
-> Mode (WithCursor FilesState)
-> Identity (Mode (WithCursor FilesState)))
-> (Segment -> Identity Segment)
-> WithCursor FilesState
-> Identity (WithCursor FilesState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
"segment"
((Segment -> Identity Segment)
-> Mode (WithCursor FilesState)
-> Identity (Mode (WithCursor FilesState)))
(Segment -> Identity Segment)
-> Mode (WithCursor FilesState)
-> Identity (Mode (WithCursor FilesState))
#segment ((Segment -> Identity Segment)
-> WithCursor FilesState -> Identity (WithCursor FilesState))
-> (Segment -> Segment)
-> Sem
(State (WithCursor FilesState)
: Menu FilesState : Reader Prompt : r)
()
forall s (r :: [(* -> *) -> * -> *]) a b.
Member (State s) r =>
ASetter s s a b -> (a -> b) -> Sem r ()
%= Segment -> Segment
FilesState.cycle
Sem
(State (WithCursor FilesState)
: Menu FilesState : Reader Prompt : r)
(Maybe (MenuAction FileAction))
forall (r :: [(* -> *) -> * -> *]) a. Sem r (Maybe (MenuAction a))
menuOk
actions ::
Members [Stop FilesError, Embed IO] r =>
NonEmpty (Path Abs Dir) ->
Mappings FilesState r FileAction
actions :: forall (r :: [(* -> *) -> * -> *]).
Members '[Stop FilesError, Embed IO] r =>
NonEmpty (Path Abs Dir) -> Mappings FilesState r FileAction
actions NonEmpty (Path Abs Dir)
bases =
[
(MappingSpec -> MappingSpec
withInsert MappingSpec
"<cr>", MenuWidget FilesState r FileAction
forall (r :: [(* -> *) -> * -> *]).
MenuWidget FilesState r FileAction
editFile),
(MappingSpec -> MappingSpec
insert MappingSpec
"<tab>", [Path Abs Dir] -> MenuWidget FilesState r FileAction
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
[Path Abs Dir] -> MenuWidget FilesState r FileAction
tab (NonEmpty (Path Abs Dir) -> [Path Abs Dir]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Path Abs Dir)
bases)),
(MappingSpec -> MappingSpec
insert MappingSpec
"<c-y>", NonEmpty (Path Abs Dir) -> MenuWidget FilesState r FileAction
forall (r :: [(* -> *) -> * -> *]).
(Member (Reader Prompt) r,
Members '[Stop FilesError, Embed IO] r) =>
NonEmpty (Path Abs Dir) -> Sem r (Maybe (MenuAction FileAction))
createFile NonEmpty (Path Abs Dir)
bases),
(MappingSpec -> MappingSpec
insert MappingSpec
"<c-s>", MenuWidget FilesState r FileAction
forall (r :: [(* -> *) -> * -> *]).
MenuWidget FilesState r FileAction
cycleSegment)
]
parsePath :: Path Abs Dir -> Text -> Maybe (Path Abs Dir)
parsePath :: Path Abs Dir -> Text -> Maybe (Path Abs Dir)
parsePath Path Abs Dir
_ Text
path | Int -> Text -> Text
Text.take Int
1 Text
path Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/" =
String -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir (Text -> String
forall a. ToString a => a -> String
toString Text
path)
parsePath Path Abs Dir
cwd Text
path =
(Path Abs Dir
cwd Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (Path Rel Dir -> Path Abs Dir)
-> Maybe (Path Rel Dir) -> Maybe (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (Text -> String
forall a. ToString a => a -> String
toString Text
path)
readRegex ::
Member (Stop FilesError) r =>
Text ->
Text ->
Sem r Regex
readRegex :: forall (r :: [(* -> *) -> * -> *]).
Member (Stop FilesError) r =>
Text -> Text -> Sem r Regex
readRegex Text
name Text
rgx =
FilesError -> Maybe Regex -> Sem r Regex
forall err (r :: [(* -> *) -> * -> *]) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Text -> Text -> FilesError
FilesError.BadRegex Text
name Text
rgx) (Either String Regex -> Maybe Regex
forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> [PCREOption] -> Either String Regex
compileM (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
rgx) [PCREOption]
forall a. Monoid a => a
mempty))
readRegexs ::
Members [Settings, Stop FilesError] r =>
Setting [Text] ->
Sem r [Regex]
readRegexs :: forall (r :: [(* -> *) -> * -> *]).
Members '[Settings, Stop FilesError] r =>
Setting [Text] -> Sem r [Regex]
readRegexs s :: Setting [Text]
s@(Setting Text
name Bool
_ Maybe [Text]
_) =
(Text -> Sem r Regex) -> [Text] -> Sem r [Regex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> Text -> Sem r Regex
forall (r :: [(* -> *) -> * -> *]).
Member (Stop FilesError) r =>
Text -> Text -> Sem r Regex
readRegex Text
name) ([Text] -> Sem r [Regex]) -> Sem r [Text] -> Sem r [Regex]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Setting [Text] -> Sem r [Text]
forall a (r :: [(* -> *) -> * -> *]).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting [Text]
s
filesConfig ::
Members [Rpc, Settings, Stop FilesError] r =>
Sem r FilesConfig
filesConfig :: forall (r :: [(* -> *) -> * -> *]).
Members '[Rpc, Settings, Stop FilesError] r =>
Sem r FilesConfig
filesConfig =
Bool -> Bool -> [Regex] -> [Regex] -> [Text] -> FilesConfig
FilesConfig (Bool -> Bool -> [Regex] -> [Regex] -> [Text] -> FilesConfig)
-> Sem r Bool
-> Sem r (Bool -> [Regex] -> [Regex] -> [Text] -> FilesConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r Bool
useRg Sem r (Bool -> [Regex] -> [Regex] -> [Text] -> FilesConfig)
-> Sem r Bool
-> Sem r ([Regex] -> [Regex] -> [Text] -> FilesConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem r Bool
hidden Sem r ([Regex] -> [Regex] -> [Text] -> FilesConfig)
-> Sem r [Regex] -> Sem r ([Regex] -> [Text] -> FilesConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem r [Regex]
fs Sem r ([Regex] -> [Text] -> FilesConfig)
-> Sem r [Regex] -> Sem r ([Text] -> FilesConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem r [Regex]
dirs Sem r ([Text] -> FilesConfig) -> Sem r [Text] -> Sem r FilesConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem r [Text]
wildignore
where
useRg :: Sem r Bool
useRg =
Setting Bool -> Sem r Bool
forall a (r :: [(* -> *) -> * -> *]).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting Bool
Settings.filesUseRg
hidden :: Sem r Bool
hidden =
Setting Bool -> Sem r Bool
forall a (r :: [(* -> *) -> * -> *]).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting Bool
Settings.filesExcludeHidden
fs :: Sem r [Regex]
fs =
Setting [Text] -> Sem r [Regex]
forall (r :: [(* -> *) -> * -> *]).
Members '[Settings, Stop FilesError] r =>
Setting [Text] -> Sem r [Regex]
readRegexs Setting [Text]
Settings.filesExcludeFiles
dirs :: Sem r [Regex]
dirs =
Setting [Text] -> Sem r [Regex]
forall (r :: [(* -> *) -> * -> *]).
Members '[Settings, Stop FilesError] r =>
Setting [Text] -> Sem r [Regex]
readRegexs Setting [Text]
Settings.filesExcludeDirectories
wildignore :: Sem r [Text]
wildignore =
Text -> Text -> [Text]
Text.splitOn Text
"," (Text -> [Text]) -> Sem r Text -> Sem r [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Sem r Text
forall a (m :: * -> *).
(MonadRpc m, MsgpackDecode a) =>
Text -> m a
nvimGetOption Text
"wildignore"
fileAction ::
Members [Rpc, Stop FilesError, Stop Report, Embed IO] r =>
FileAction ->
Sem r ()
fileAction :: forall (r :: [(* -> *) -> * -> *]).
Members '[Rpc, Stop FilesError, Stop Report, Embed IO] r =>
FileAction -> Sem r ()
fileAction = \case
Create Path Abs File
path ->
Path Abs File -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Rpc, Stop FilesError, Embed IO] r =>
Path Abs File -> Sem r ()
createAndEditFile Path Abs File
path
Edit NonEmpty (Path Abs File)
paths ->
(Path Abs File -> Sem r ()) -> NonEmpty (Path Abs File) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Path Abs File -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) b t.
Member Rpc r =>
Path b t -> Sem r ()
edit NonEmpty (Path Abs File)
paths
FileAction
NoAction ->
Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit
type FilesStack =
[
WindowMenus () FilesState !! RpcError,
Log,
Async,
Embed IO
]
filesMenu ::
Members FilesStack r =>
Members [Stop FilesError, Stop Report, Settings, Rpc] r =>
Path Abs Dir ->
[Text] ->
Sem r ()
Path Abs Dir
cwd [Text]
pathSpecs = do
forall e (r :: [(* -> *) -> * -> *]) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @RpcError do
FilesConfig
conf <- Sem (Stop RpcError : r) FilesConfig
forall (r :: [(* -> *) -> * -> *]).
Members '[Rpc, Settings, Stop FilesError] r =>
Sem r FilesConfig
filesConfig
SerialT IO (MenuItem FileSegments)
items <- (MenuItem (Path Abs File) -> MenuItem FileSegments)
-> SerialT IO (MenuItem (Path Abs File))
-> SerialT IO (MenuItem FileSegments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Path Abs File -> FileSegments)
-> MenuItem (Path Abs File) -> MenuItem FileSegments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs File -> FileSegments
fileSegments) (SerialT IO (MenuItem (Path Abs File))
-> SerialT IO (MenuItem FileSegments))
-> Sem (Stop RpcError : r) (SerialT IO (MenuItem (Path Abs File)))
-> Sem (Stop RpcError : r) (SerialT IO (MenuItem FileSegments))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilesConfig
-> NonEmpty (Path Abs Dir)
-> Sem (Stop RpcError : r) (SerialT IO (MenuItem (Path Abs File)))
forall (r :: [(* -> *) -> * -> *]).
Members '[Async, Embed IO] r =>
FilesConfig
-> NonEmpty (Path Abs Dir)
-> Sem r (SerialT IO (MenuItem (Path Abs File)))
files FilesConfig
conf NonEmpty (Path Abs Dir)
nePaths
MenuResult FileAction
result <- SerialT IO (MenuItem (Item FilesState))
-> FilesState
-> WindowOptions
-> Mappings FilesState (Stop RpcError : r) FileAction
-> Sem (Stop RpcError : r) (MenuResult FileAction)
forall res result s (r :: [(* -> *) -> * -> *]).
(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 FilesState))
SerialT IO (MenuItem FileSegments)
items (FilesMode -> FilesState
forall mode i. mode -> Modal mode i
modal (Filter -> Segment -> FilesMode
FilesMode Filter
Fuzzy Segment
Full)) WindowOptions
window (NonEmpty (Path Abs Dir)
-> Mappings FilesState (Stop RpcError : r) FileAction
forall (r :: [(* -> *) -> * -> *]).
Members '[Stop FilesError, Embed IO] r =>
NonEmpty (Path Abs Dir) -> Mappings FilesState r FileAction
actions NonEmpty (Path Abs Dir)
nePaths)
(FileAction -> Sem (Stop RpcError : r) ())
-> MenuResult FileAction -> Sem (Stop RpcError : r) ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Rpc, Stop Report] r =>
(a -> Sem r ()) -> MenuResult a -> Sem r ()
handleResult FileAction -> Sem (Stop RpcError : r) ()
forall (r :: [(* -> *) -> * -> *]).
Members '[Rpc, Stop FilesError, Stop Report, Embed IO] r =>
FileAction -> Sem r ()
fileAction MenuResult FileAction
result
where
window :: WindowOptions
window =
WindowOptions
forall a. Default a => a
def WindowOptions -> (WindowOptions -> WindowOptions) -> WindowOptions
forall a b. a -> (a -> b) -> b
& IsLabel
"prompt"
(ASetter WindowOptions WindowOptions PromptConfig PromptConfig)
ASetter WindowOptions WindowOptions PromptConfig PromptConfig
#prompt ASetter WindowOptions WindowOptions PromptConfig PromptConfig
-> PromptConfig -> WindowOptions -> WindowOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PromptConfig
OnlyInsert 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
opt
opt :: ScratchOptions
opt =
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
filesSyntax],
$sel:filetype:ScratchOptions :: Maybe Text
filetype = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
}
name :: Text
name =
Text
"proteome-files"
nePaths :: NonEmpty (Path Abs Dir)
nePaths =
NonEmpty (Path Abs Dir)
-> Maybe (NonEmpty (Path Abs Dir)) -> NonEmpty (Path Abs Dir)
forall a. a -> Maybe a -> a
fromMaybe (Path Abs Dir
cwd Path Abs Dir -> [Path Abs Dir] -> NonEmpty (Path Abs Dir)
forall a. a -> [a] -> NonEmpty a
:| []) ([Path Abs Dir] -> Maybe (NonEmpty (Path Abs Dir))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Path Abs Dir]
absPaths)
absPaths :: [Path Abs Dir]
absPaths =
(Text -> Maybe (Path Abs Dir)) -> [Text] -> [Path Abs Dir]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Path Abs Dir -> Text -> Maybe (Path Abs Dir)
parsePath Path Abs Dir
cwd) [Text]
pathSpecs
proFiles ::
Members FilesStack r =>
Members [Rpc !! RpcError, Settings !! SettingError] r =>
ArgList ->
Handler r ()
proFiles :: forall (r :: [(* -> *) -> * -> *]).
(Members FilesStack r,
Members '[Rpc !! RpcError, Settings !! SettingError] r) =>
ArgList -> Handler r ()
proFiles (ArgList [Text]
paths) =
forall e (r :: [(* -> *) -> * -> *]) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport @FilesError (Sem (Stop FilesError : Stop Report : r) ()
-> Sem (Stop Report : r) ())
-> Sem (Stop FilesError : Stop Report : r) ()
-> Sem (Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ forall (eff :: (* -> *) -> * -> *) e (r :: [(* -> *) -> * -> *]) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc (Sem (Rpc : Stop FilesError : Stop Report : r) ()
-> Sem (Stop FilesError : Stop Report : r) ())
-> Sem (Rpc : Stop FilesError : Stop Report : r) ()
-> Sem (Stop FilesError : Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ forall (eff :: (* -> *) -> * -> *) e (r :: [(* -> *) -> * -> *]) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Settings do
Path Abs Dir
cwd <- FilesError
-> InterpreterFor
Rpc (Settings : Rpc : Stop FilesError : Stop Report : r)
forall err (eff :: (* -> *) -> * -> *) err'
(r :: [(* -> *) -> * -> *]).
Members '[Resumable err eff, Stop err'] r =>
err' -> InterpreterFor eff r
resumeHoistAs FilesError
FilesError.BadCwd Sem
(Rpc : Settings : Rpc : Stop FilesError : Stop Report : r)
(Path Abs Dir)
forall (m :: * -> *). MonadRpc m => m (Path Abs Dir)
nvimCwd
Path Abs Dir
-> [Text]
-> Sem (Settings : Rpc : Stop FilesError : Stop Report : r) ()
forall (r :: [(* -> *) -> * -> *]).
(Members FilesStack r,
Members '[Stop FilesError, Stop Report, Settings, Rpc] r) =>
Path Abs Dir -> [Text] -> Sem r ()
filesMenu Path Abs Dir
cwd [Text]
paths