packages feed

proteome 0.3.17.0 → 0.9.9.9

raw patch · 93 files changed

+4927/−1955 lines, 93 filesdep +Globdep +attoparsecdep +chiasmadep −HTFdep −MissingHdep −aesondep ~base

Dependencies added: Glob, attoparsec, chiasma, chronos, exon, extra, filepattern, lens-regex-pcre, microlens, nonempty-zipper, parsers, path, path-io, pcre-light, polysemy, polysemy-chronos, polysemy-plugin, polysemy-process, prelate, raw-strings-qq, ribosome-host, ribosome-menu, stm-chans, streamly, streamly-process, typed-process

Dependencies removed: HTF, MissingH, aeson, ansi-terminal, bytestring, containers, data-default-class, deepseq, directory, either, filepath, hslogger, messagepack, mtl, nvim-hs, pretty-terminal, process, resourcet, safe, split, stm, strings, text, time, unliftio, utf8-string

Dependency ranges changed: base

Files

LICENSE view
@@ -1,21 +1,34 @@-The MIT License (MIT)+Copyright (c) 2021 Torsten Schmits -Copyright (c) 2018 Torsten Schmits+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met: -Permission is hereby granted, free of charge, to any person obtaining a copy of-this software and associated documentation files (the "Software"), to deal in-the Software without restriction, including without limitation the rights to-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies-of the Software, and to permit persons to whom the Software is furnished to do-so, subject to the following conditions:+  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+  disclaimer in the documentation and/or other materials provided with the distribution. -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by: -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.+  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
− README.md 
@@ -1,13 +0,0 @@-# Intro--A neovim plugin that provides project-specific configuration file loading and performs runtime tasks on projects.--# Install--Use the [chromatin] plugin manager with the spec `hackage:proteome`:--```vim-let g:chromatin_rplugins += [{ 'spec': 'hackage:proteome', 'name': 'proteome' }]-```--[chromatin]: https://github.com/tek/chromatin.nvim
app/Main.hs view
@@ -1,6 +1,7 @@-import Neovim+module Main where -import Proteome.Plugin (plugin)+import Proteome.Plugin (proteome)  main :: IO ()-main = neovim defaultConfig {plugins = [plugin]}+main =+  proteome
lib/Proteome/Add.hs view
@@ -1,50 +1,167 @@-{-# LANGUAGE RecordWildCards #-}--module Proteome.Add(-  proAdd,-  proAddCmd,-)-where+module Proteome.Add where -import Control.Monad (when)-import Control.Lens (over)-import Data.List.Utils (split)-import Neovim (nvim_err_writeln', CommandArguments(CommandArguments, bang))-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Proteome.Data.AddOptions (AddOptions(AddOptions))-import Proteome.Data.Env (_projects)-import Proteome.Data.Project (-  meta,-  ProjectMetadata(VirtualProject),-  ProjectName(ProjectName),-  ProjectType(ProjectType),+import qualified Data.Text as Text+import Path (Abs, Dir, Path, dirname, parent, stripProperPrefix)+import Path.IO (listDir)+import Ribosome (+  Bang (Bang),+  Handler,+  PluginName,+  Rpc,+  RpcError,+  SettingError,+  Settings,+  mapReport,+  pathText,+  resumeReport,   )+import Ribosome.Menu (+  Filter (Fuzzy),+  MenuItem (..),+  MenuResult,+  MenuWidget,+  ModalState,+  ModalWindowMenus,+  modal,+  staticWindowMenu,+  traverseSelection_,+  )+import Ribosome.Scratch (scratch, syntax)+import qualified Ribosome.Settings as Settings++import Proteome.Add.Syntax (addSyntax)+import qualified Proteome.Data.AddError as AddError+import Proteome.Data.AddError (AddError)+import Proteome.Data.AddItem (AddItem (AddItem))+import Proteome.Data.AddOptions (AddOptions (AddOptions))+import Proteome.Data.Env (Env)+import Proteome.Data.Project (Project (Project))+import qualified Proteome.Data.ProjectConfig as ProjectConfig+import Proteome.Data.ProjectConfig (ProjectConfig)+import Proteome.Data.ProjectMetadata (ProjectMetadata (VirtualProject))+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectType (ProjectType (ProjectType))+import Proteome.Data.ResolveError (ResolveError)+import Proteome.Path (dropSlash) import Proteome.Project.Activate (selectProject)-import Proteome.Project.Resolve (resolveProjectFromConfig)-import Proteome.Data.Proteome (Proteome)+import Proteome.Project.Resolve (fromNameSettings)+import qualified Proteome.Settings as Settings -add :: ProjectName -> Maybe ProjectType -> Bool -> Proteome ()+type AddState =+  ModalState AddItem++add ::+  Members [Settings, Rpc, AtomicState Env, Reader PluginName, Stop ResolveError, Log, Embed IO] r =>+  ProjectName ->+  Maybe ProjectType ->+  Bool ->+  Sem r () add name tpe activate = do-  project <- resolveProjectFromConfig Nothing name tpe-  case meta project of-    VirtualProject _ -> return ()-    _ -> Ribo.modify $ over _projects (\p -> p ++ [project])-  when activate $ selectProject (-1)+  addDirProject =<< fromNameSettings name tpe+  when activate (selectProject (-1))+  where+    addDirProject (Project (VirtualProject _) _ _ _) =+      unit+    addDirProject project =+      atomicModify' (#projects <>~ [project]) -proAdd :: AddOptions -> Proteome ()+proAdd ::+  Members [Settings !! SettingError, Rpc !! RpcError, AtomicState Env, Reader PluginName, Log, Embed IO] r =>+  AddOptions ->+  Handler r () proAdd (AddOptions name tpe activate) =-  add name (Just tpe) activate+  resumeReport @Settings $ resumeReport @Rpc $ mapReport do+    add name (Just tpe) (fromMaybe False activate) -addFromName :: ProjectName -> Bool -> Proteome ()-addFromName name = add name Nothing+addFromName ::+  Members [Settings, Rpc, AtomicState Env, Reader PluginName, Stop ResolveError, Log, Embed IO] r =>+  ProjectName ->+  Bool ->+  Sem r ()+addFromName name =+  add name Nothing -proAddCmd :: CommandArguments -> String -> Proteome ()-proAddCmd args spec =-  case split "/" spec of-    [tpe, name] -> add (ProjectName name) (Just (ProjectType tpe)) activate-    [name] -> addFromName (ProjectName name) activate-    _ -> nvim_err_writeln' $ "invalid project spec: " ++ spec+proAddCmd ::+  Members [Settings !! SettingError, Rpc !! RpcError, AtomicState Env, Reader PluginName, Log, Embed IO] r =>+  Bang ->+  Text ->+  Handler r ()+proAddCmd bang spec =+  resumeReport @Settings $ resumeReport @Rpc $ mapReport @ResolveError $ mapReport @AddError do+    process (Text.splitOn "/" spec)   where-    activate = case args of-      CommandArguments { bang = Just True, .. } -> True-      _ -> False+    process [tpe, name] =+      add (ProjectName name) (Just (ProjectType tpe)) activate+    process [name] =+      addFromName (ProjectName name) (bang == Bang)+    process _ =+      stop (AddError.InvalidProjectSpec spec)+    activate =+      bang == Bang++availableProjectsInBase ::+  Members [Stop AddError, Embed IO] r =>+  Path Abs Dir ->+  Sem r [MenuItem AddItem]+availableProjectsInBase base =+  fmap (fmap cons . join) . traverse list =<< list base+  where+    list d =+      stopEitherWith AddError.Directory =<< tryAny (fst <$> listDir d)+    cons proj =+      MenuItem (AddItem tpe name) pt (maybe pt dropSlash (stripProperPrefix base proj))+      where+        tpe =+          dropSlash (dirname (parent proj))+        name =+          dropSlash (dirname proj)+        pt =+          pathText proj++availableProjects ::+  Members [Stop AddError, Embed IO] r =>+  ProjectConfig ->+  Sem r [MenuItem AddItem]+availableProjects (ProjectConfig.baseDirs -> dirs) =+  join <$> traverse availableProjectsInBase dirs++menuAdd ::+  Members [Settings, Rpc, AtomicState Env, Reader PluginName, Stop ResolveError, Log, Embed IO] r =>+  MenuWidget AddState r ()+menuAdd =+  traverseSelection_ \ (AddItem tpe name) ->+    add (ProjectName name) (Just (ProjectType tpe)) True++type AddStack =+  [+    ModalWindowMenus () AddItem !! RpcError,+    AtomicState Env,+    Reader PluginName,+    Settings !! SettingError,+    Rpc !! RpcError,+    Log,+    Embed IO+  ]++addMenu ::+  Members AddStack r =>+  Members [Rpc, Settings, Stop ResolveError, Stop AddError, Stop RpcError] r =>+  Sem r (MenuResult ())+addMenu = do+  projectConfig <- Settings.get Settings.projectConfig+  projects <- sort <$> availableProjects projectConfig+  staticWindowMenu projects (modal Fuzzy) (def & #items .~ scratchOptions) [("<cr>", menuAdd)]+  where+    scratchOptions =+      (scratch "proteome-add") { syntax = [addSyntax] }++proAddMenu ::+  Members AddStack r =>+  Handler r ()+proAddMenu =+  resumeReport @Rpc $+  resumeReport @Settings $+  mapReport @AddError $+  mapReport @ResolveError $+  mapReport @RpcError do+    void $ addMenu
+ lib/Proteome/Add/Syntax.hs view
@@ -0,0 +1,36 @@+module Proteome.Add.Syntax where++import qualified Data.Map.Strict as Map (fromList)+import Ribosome.Data.Syntax.Syntax (HiLink (HiLink), Syntax (Syntax))+import Ribosome.Data.SyntaxItem (SyntaxItem (options, params))+import Ribosome.Syntax (syntaxMatch, syntaxVerbatim)+import Text.RawString.QQ (r)++asterisk :: SyntaxItem+asterisk =+  item {options, params}+  where+    item = syntaxMatch "ProAddAsterisk" [r|^ \*|]+    options = ["skipwhite"]+    params = Map.fromList [("nextgroup", "ProAddName")]++sync :: SyntaxItem+sync =+  syntaxVerbatim "syntax sync minlines=1"++hlAsterisk :: HiLink+hlAsterisk =+  HiLink "ProAddAsterisk" "Todo"++hlName :: HiLink+hlName =+  HiLink "ProAddName" "Type"++addSyntax :: Syntax+addSyntax =+  Syntax items [] links+  where+    items =+      [asterisk, sync]+    links =+      [hlAsterisk, hlName]
lib/Proteome/BufEnter.hs view
@@ -1,30 +1,62 @@-module Proteome.BufEnter(-  bufEnter,-) where+module Proteome.BufEnter where -import Data.List (intercalate)-import Data.Maybe (maybeToList)-import System.FilePath ((</>))-import Neovim (buffer_set_option', Neovim, vim_get_current_buffer', toObject)-import Ribosome.Config.Setting (setting)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (Project(Project), ProjectMetadata(DirProject), ProjectRoot(ProjectRoot))+import Conc (Lock, lock)+import Data.List.Extra (nub)+import qualified Data.Text as Text (intercalate)+import Path (Abs, Dir, File, Path, toFilePath, (</>))+import Ribosome (Buffer, Handler, Rpc, RpcError, Settings, resumeReport)+import Ribosome.Api (bufferSetOption, vimGetCurrentBuffer)+import Ribosome.Api.Buffer (bufferIsFile, buflisted)+import Ribosome.Data.SettingError (SettingError)+import qualified Ribosome.Settings as Settings++import Proteome.Data.Env (Env)+import qualified Proteome.Data.Env as Env (buffers)+import Proteome.Data.Project (Project (Project))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot)) import Proteome.Project (allProjects) import Proteome.Settings (tagsFileName) -setBufferTags :: [String] -> Neovim e ()+data Mru =+  Mru+  deriving stock (Eq, Show)++setBufferTags ::+  Member Rpc r =>+  [Path Abs File] ->+  Sem r () setBufferTags tags = do-  buf <- vim_get_current_buffer'-  buffer_set_option' buf "tags" (toObject $ intercalate "," tags)+  buf <- vimGetCurrentBuffer+  bufferSetOption buf "tags" (Text.intercalate "," (toText . toFilePath <$> tags)) -projectRoot :: Project -> Maybe FilePath+projectRoot :: Project -> Maybe (Path Abs Dir) projectRoot (Project (DirProject _ (ProjectRoot root) _) _ _ _) = Just root projectRoot _ = Nothing -bufEnter :: Proteome ()-bufEnter = do-  pros <- allProjects-  name <- setting tagsFileName-  let roots = pros >>= maybeToList . projectRoot-  let tags = fmap (</> name) roots-  setBufferTags tags+updateBufferMru ::+  Members [AtomicState Env, Lock @@ Mru, Rpc !! RpcError, Resource] r =>+  Buffer ->+  Sem r ()+updateBufferMru buffer = do+  tag $ lock do+    old <- atomicGets Env.buffers+    new <- filterM buflisted (nub (buffer : old))+    atomicModify' (#buffers .~ new)++updateBuffers ::+  Members [AtomicState Env, Lock @@ Mru, Rpc, Rpc !! RpcError, Resource] r =>+  Sem r ()+updateBuffers = do+  current <- vimGetCurrentBuffer+  whenM (bufferIsFile current) (updateBufferMru current)++bufEnter ::+  Members [AtomicState Env, Lock @@ Mru, Rpc !! RpcError, Settings !! SettingError, Resource] r =>+  Handler r ()+bufEnter =+  resumeReport @Rpc do+    updateBuffers+    roots <- mapMaybe projectRoot <$> allProjects+    name <- resumeReport (Settings.get tagsFileName)+    setBufferTags ((</> name) <$> roots)
+ lib/Proteome/Buffers.hs view
@@ -0,0 +1,211 @@+module Proteome.Buffers where++import Control.Lens (elemOf, view)+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Text as Text+import Exon (exon)+import Ribosome (+  Handler,+  Report,+  Rpc,+  RpcError,+  ScratchId (ScratchId),+  SettingError,+  Settings,+  mapReport,+  pathText,+  resumeReport,+  )+import Ribosome.Api (+  bufferGetName,+  bufferGetNumber,+  bufferIsFile,+  buflisted,+  ensureMainWindow,+  nvimBufIsLoaded,+  nvimCommand,+  nvimCwd,+  setCurrentBuffer,+  vimGetCurrentBuffer,+  vimGetCurrentWindow,+  vimSetCurrentWindow,+  )+import Ribosome.Menu (+  Filter (Fuzzy),+  Mappings,+  MenuAction (Render),+  MenuItem (MenuItem),+  MenuWidget,+  ModalState,+  ModalWindowMenus,+  deleteSelected,+  menuState,+  modal,+  staticWindowMenu,+  unselected,+  use,+  withFocus,+  withSelection',+  )+import Ribosome.Scratch (ScratchOptions (..))+import qualified Ribosome.Settings as Settings++import Proteome.Buffers.Syntax (buffersSyntax)+import qualified Proteome.Data.Env as Env+import Proteome.Data.Env (Env)+import qualified Proteome.Data.ListedBuffer as ListedBuffer+import Proteome.Data.ListedBuffer (ListedBuffer (ListedBuffer))+import Proteome.Menu (handleResult)+import qualified Proteome.Settings as Settings++newtype BufferAction =+  Load ListedBuffer+  deriving stock (Eq, Show)++type BuffersState =+  ModalState ListedBuffer++loadListedBuffer ::+  Member Rpc r =>+  ListedBuffer ->+  Sem r ()+loadListedBuffer (ListedBuffer buffer number _) =+  ifM (nvimBufIsLoaded buffer) (setCurrentBuffer buffer) (nvimCommand [exon|buffer #{show number}|])++load ::+  MenuWidget BuffersState r BufferAction+load =+  withFocus (pure . Load)++compensateForMissingActiveBuffer ::+  Member Rpc r =>+  NonEmpty ListedBuffer ->+  [ListedBuffer] ->+  Sem r ()+compensateForMissingActiveBuffer _ [] =+  nvimCommand "enew"+compensateForMissingActiveBuffer marked (next : _) = do+  prev <- vimGetCurrentWindow+  void ensureMainWindow+  current <- vimGetCurrentBuffer+  when (elemOf (each . #buffer) current marked) (loadListedBuffer next)+  vimSetCurrentWindow prev++deleteListedBuffersWith ::+  Member Rpc r =>+  Text ->+  NonEmpty ListedBuffer ->+  Sem r ()+deleteListedBuffersWith deleter bufs =+  nvimCommand [exon|#{deleter} #{numbers}|]+  where+    numbers =+      unwords (show . ListedBuffer.number <$> NonEmpty.toList bufs)++deleteWith ::+  Member Rpc r =>+  Text ->+  MenuWidget BuffersState r a+deleteWith deleter =+  menuState $ withSelection' \ delete -> do+    keep <- fmap (view #meta) <$> use unselected+    compensateForMissingActiveBuffer delete keep+    deleteListedBuffersWith deleter delete+    deleteSelected+    pure Render++moveCurrentLast ::+  Member Rpc r =>+  [MenuItem ListedBuffer] ->+  Sem r [MenuItem ListedBuffer]+moveCurrentLast items = do+  current <- vimGetCurrentBuffer+  pure $ spin current items []+  where+    spin current (item : rest) result | item ^. lens == current =+      result ++ rest ++ [item]+    spin current (item : rest) result =+      spin current rest (item : result)+    spin _ [] result =+      result+    lens =+      #meta . #buffer++buffers ::+  Members [AtomicState Env, Settings !! SettingError, Rpc, Rpc !! RpcError] r =>+  Sem r [MenuItem ListedBuffer]+buffers = do+  cwd <- nvimCwd+  bufs <- filterM bufferIsFile =<< filterM buflisted =<< atomicGets Env.buffers+  numbers <- traverse bufferGetNumber bufs+  names <- traverse bufferGetName bufs+  let items = item (pathText cwd) (padding numbers) <$> zip3 bufs numbers names+  ifM (Settings.or False Settings.buffersCurrentLast) (moveCurrentLast items) (pure items)+  where+    padding =+      Text.length . show . maximum+    item cwd pad (buf, num, name) =+      MenuItem (ListedBuffer buf num name) text' text'+      where+        text' =+          " * " <> padded pad (show num) <> "  " <> strip cwd name+    padded pad num =+      Text.replicate (pad - Text.length num) " " <> num+    strip cwd name =+      fromMaybe name $ Text.stripPrefix cwd name++actions ::+  Member Rpc r =>+  Mappings BuffersState r BufferAction+actions =+  [+    ("<cr>", load),+    ("d", deleteWith "bdelete"),+    ("D", deleteWith "bdelete!"),+    ("w", deleteWith "bwipeout"),+    ("W", deleteWith "bwipeout!")+  ]++bufferAction ::+  Member Rpc r =>+  BufferAction ->+  Sem r ()+bufferAction = \case+  Load buf ->+    loadListedBuffer buf++type BuffersStack =+  [+    ModalWindowMenus () ListedBuffer !! RpcError,+    AtomicState Env,+    Settings !! SettingError,+    Rpc !! RpcError,+    Log+  ]++buffersMenu ::+  ∀ r .+  Members BuffersStack r =>+  Members [Rpc, Stop Report] r =>+  Sem r ()+buffersMenu = do+  items <- buffers+  result <- mapReport do+    staticWindowMenu items (modal Fuzzy) (def & #items .~ scratchOptions) actions+  handleResult bufferAction result+  where+    scratchOptions =+      def {+        name = ScratchId name,+        syntax = [buffersSyntax],+        filetype = Just name+      }+    name =+      "proteome-buffers"++proBuffers ::+  Members BuffersStack r =>+  Handler r ()+proBuffers =+  resumeReport @Rpc do+    buffersMenu
+ lib/Proteome/Buffers/Syntax.hs view
@@ -0,0 +1,54 @@+module Proteome.Buffers.Syntax where++import qualified Data.Map.Strict as Map (fromList)+import Ribosome.Data.SyntaxItem (SyntaxItem (options, params))+import Ribosome.Syntax (HiLink (HiLink), Syntax (Syntax), syntaxMatch, syntaxVerbatim)+import Text.RawString.QQ (r)++asterisk :: SyntaxItem+asterisk =+  item {options, params}+  where+    item = syntaxMatch "ProBuffersAsterisk" [r|^ \*|]+    options = ["skipwhite"]+    params = Map.fromList [("nextgroup", "ProBuffersNumber")]++number :: SyntaxItem+number =+  item {options, params}+  where+    item = syntaxMatch "ProBuffersNumber" [r|\d\+|]+    options = ["contained", "skipwhite"]+    params = Map.fromList [("nextgroup", "ProBuffersName")]++line :: SyntaxItem+line =+  item {options}+  where+    item = syntaxMatch "ProBuffersName" ".*$"+    options = ["contained"]++sync :: SyntaxItem+sync =+  syntaxVerbatim "syntax sync minlines=1"++hlAsterisk :: HiLink+hlAsterisk =+  HiLink "ProBuffersAsterisk" "Todo"++hlNumber :: HiLink+hlNumber =+  HiLink "ProBuffersNumber" "Directory"++hlName :: HiLink+hlName =+  HiLink "ProBuffersName" "Type"++buffersSyntax :: Syntax+buffersSyntax =+  Syntax items [] links+  where+    items =+      [asterisk, number, line, sync]+    links =+      [hlAsterisk, hlNumber, hlName]
lib/Proteome/Config.hs view
@@ -1,113 +1,105 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE RecordWildCards #-}--module Proteome.Config(-  proReadConfig,-  readConfig,-  ProjectConfig (..),-  logConfig,-)-where--import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import Control.Lens (over)-import Control.Monad (join)-import qualified Data.Map as Map-import Data.Map.Strict (Map)-import Data.Maybe (fromMaybe)-import Data.Text.Prettyprint.Doc ((<+>), viaShow)-import Neovim (NvimObject(..), Dictionary, Object(ObjectMap), vim_command')-import Ribosome.Control.Ribo (Ribo)-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Ribosome.Api.Function (callFunction)-import Ribosome.Api.Option (optionString)-import Ribosome.Internal.NvimObject (extractObject)-import Proteome.Data.Env (_configLog)-import Proteome.Data.Project (-  Project(Project, types),-  ProjectType(ProjectType, projectType),-  ProjectLang,-  ProjectName(ProjectName),-  ProjectMetadata(DirProject),-  )-import Proteome.Data.Proteome-import Proteome.Env (getMainProject)+module Proteome.Config where -data ProjectConfig =-  ProjectConfig {-    projectTypes :: Map ProjectType [FilePath],-    typeMap :: Map ProjectType [ProjectType],-    langMap :: Map ProjectType ProjectLang,-    langsMap :: Map ProjectLang [ProjectLang]-  }-  deriving (Generic, NFData)+import Exon (exon)+import Ribosome (Handler, Rpc, RpcError, msgpackArray, resumeReport)+import Ribosome.Api (nvimGetOption, vimCallFunction, vimCommand) -instance NvimObject ProjectConfig where-  toObject ProjectConfig {..} =-    (toObject :: Dictionary -> Object) . Map.fromList $-    [-      ("projectTypes", toObject projectTypes),-      ("typeMap", toObject typeMap),-      ("langMap", toObject langMap),-      ("langsMap", toObject langsMap)-    ]-  fromObject (ObjectMap o) = do-    projectTypes' <- extractObject "projectTypes" o-    typeMap' <- extractObject "typeMap" o-    langMap' <- extractObject "langMap" o-    langsMap' <- extractObject "langsMap" o-    return $ ProjectConfig projectTypes' typeMap' langMap' langsMap'-  fromObject o = Left ("invalid type for ProjectConfig: " <+> viaShow o)+import qualified Proteome.Data.Env as Env+import Proteome.Data.Env (Env)+import qualified Proteome.Data.Project as Project+import Proteome.Data.Project (Project (Project))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectType (ProjectType (ProjectType)) -globRtp :: FilePath -> Ribo a [FilePath]+globRtp ::+  Member Rpc r =>+  Text ->+  Sem r [Text] globRtp path = do-  rtp <- optionString "runtimepath"-  callFunction "globpath" [toObject rtp, toObject path, toObject False, toObject True]+  rtp :: Text <- nvimGetOption "runtimepath"+  vimCallFunction "globpath" (msgpackArray rtp path False True) -runtime :: FilePath -> Ribo a [FilePath]+runtime ::+  Member Rpc r =>+  Text ->+  Sem r [Text] runtime path = do-  vim_command' $ "runtime! " ++ fpath+  vimCommand [exon|runtime! #{fpath}|]   globRtp fpath-  where fpath = path ++ ".vim"+  where+    fpath = path <> ".vim" -runtimeConf :: FilePath -> String -> Ribo a [FilePath]-runtimeConf confDir path = runtime (confDir ++ "/" ++ path)+runtimeConf ::+  Member Rpc r =>+  Text ->+  Text ->+  Sem r [Text]+runtimeConf confDir path =+  runtime [exon|#{confDir}/#{path}|] -typeProjectConf :: FilePath -> ProjectName -> ProjectType -> Ribo a [FilePath]+typeProjectConf ::+  Member Rpc r =>+  Text ->+  ProjectName ->+  ProjectType ->+  Sem r [Text] typeProjectConf confDir (ProjectName name') (ProjectType tpe') = do   tpePaths <- runtimeConf confDir tpe'-  namePaths <- runtimeConf confDir $ tpe' ++ "/" ++ name'-  return $ tpePaths ++ namePaths+  namePaths <- runtimeConf confDir $ tpe' <> "/" <> name'+  pure $ tpePaths <> namePaths -readConfigMeta :: String -> Project -> Ribo a [FilePath]+readConfigMeta ::+  Member Rpc r =>+  Text ->+  Project ->+  Sem r [Text] readConfigMeta confDir (Project (DirProject name' _ tpe') _ _ _) = do   paths <- traverse (typeProjectConf confDir name') tpe'-  return $ fromMaybe [] paths-readConfigMeta _ _ = return []+  pure $ fromMaybe [] paths+readConfigMeta _ _ = pure [] -readConfigProject :: String -> Project -> Ribo a [FilePath]+readConfigProject ::+  Member Rpc r =>+  Text ->+  Project ->+  Sem r [Text] readConfigProject confDir project = do-  paths <- traverse (runtimeConf confDir) (fmap projectType (types project))+  paths <- traverse (runtimeConf confDir . coerce) (Project.types project)   metaPaths <- readConfigMeta confDir project-  return $ join paths ++ metaPaths+  pure $ join paths <> metaPaths -readConfig :: String -> Project -> Ribo a [FilePath]+readConfig ::+  Member Rpc r =>+  Text ->+  Project ->+  Sem r [Text] readConfig confDir project = do   allPaths <- runtimeConf confDir "all/*"   projectPaths <- readConfigProject confDir project-  return $ allPaths ++ projectPaths+  pure $ allPaths <> projectPaths -logConfig :: [FilePath] -> Proteome ()+logConfig ::+  Member (AtomicState Env) r =>+  [Text] ->+  Sem r () logConfig paths =-  Ribo.modify $ over _configLog (paths ++)+  atomicModify' (#configLog %~ (paths <>)) -proReadConfig :: Proteome ()+proReadConfig ::+  Members [Rpc !! RpcError, AtomicState Env] r =>+  Handler r () proReadConfig = do-  main <- getMainProject-  configs <- readConfig "project" main-  logConfig configs-  afterConfigs <- readConfig "project_after" main-  logConfig afterConfigs+  resumeReport @Rpc do+    main <- atomicGets Env.mainProject+    configs <- readConfig "project" main+    logConfig configs+    afterConfigs <- readConfig "project_after" main+    logConfig afterConfigs++defaultTypeMarkers :: Map ProjectType [Text]+defaultTypeMarkers =+  [+    (ProjectType "haskell", ["stack.yaml", "*.cabal", "cabal.project"]),+    (ProjectType "scala", ["*.sbt"])+  ]
lib/Proteome/Data/ActiveProject.hs view
@@ -1,22 +1,10 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}+module Proteome.Data.ActiveProject where -module Proteome.Data.ActiveProject(-  ActiveProject(ActiveProject),-) where+import Ribosome (MsgpackDecode, MsgpackEncode) -import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import qualified Data.Map as Map (fromList)-import Neovim (Object)-import Neovim.Classes (NvimObject(..), Dictionary)-import Proteome.Data.Project(-  ProjectName,-  ProjectType,-  ProjectLang-  )+import Proteome.Data.ProjectLang (ProjectLang)+import Proteome.Data.ProjectName (ProjectName)+import Proteome.Data.ProjectType (ProjectType)  data ActiveProject =   ActiveProject {@@ -24,14 +12,5 @@     tpe :: ProjectType,     lang :: Maybe ProjectLang   }-  deriving (Eq, Show, Generic, NFData)--instance NvimObject ActiveProject where-  toObject ActiveProject {..} =-    (toObject :: Dictionary -> Object) . Map.fromList $-    [-      ("name", toObject name),-      ("tpe", toObject tpe),-      ("lang", toObject lang)-    ]-  fromObject _ = Left "ActiveProject is write-only"+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackDecode, MsgpackEncode)
+ lib/Proteome/Data/AddError.hs view
@@ -0,0 +1,18 @@+module Proteome.Data.AddError where++import Exon (exon)+import Log (Severity (Info))+import Ribosome (Report (Report), Reportable (toReport))++data AddError =+  InvalidProjectSpec Text+  |+  Directory Text+  deriving stock (Eq, Show)++instance Reportable AddError where+  toReport = \case+    InvalidProjectSpec spec ->+      Report [exon|no such project: #{spec}|] ["AddError.InvalidProjectSpec:", spec] Info+    Directory msg ->+      Report [exon|Listing directories: #{msg}|] ["AddError.Directory:", msg] Info
+ lib/Proteome/Data/AddItem.hs view
@@ -0,0 +1,8 @@+module Proteome.Data.AddItem where++data AddItem =+  AddItem {+     projectType :: Text,+     projectName :: Text+  }+  deriving stock (Eq, Show, Ord)
lib/Proteome/Data/AddOptions.hs view
@@ -1,38 +1,15 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}+module Proteome.Data.AddOptions where -module Proteome.Data.AddOptions(-  AddOptions(..),-) where+import Ribosome (MsgpackDecode, MsgpackEncode) -import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import qualified Data.Map as Map (fromList)-import Data.Text.Prettyprint.Doc ((<+>), viaShow)-import Neovim (NvimObject(..), Dictionary, Object(ObjectMap))-import Ribosome.Internal.NvimObject (extractObject, extractObjectOr)-import Proteome.Data.Project (ProjectName, ProjectType)+import Proteome.Data.ProjectName (ProjectName)+import Proteome.Data.ProjectType (ProjectType)  data AddOptions =   AddOptions {     name :: ProjectName,     tpe :: ProjectType,-    activate :: Bool+    activate :: Maybe Bool   }-  deriving (Eq, Show, Generic, NFData)--instance NvimObject AddOptions where-  toObject AddOptions {..} =-    (toObject :: Dictionary -> Object) . Map.fromList $-    [-      ("name", toObject name),-      ("tpe", toObject tpe),-      ("activate", toObject activate)-    ]-  fromObject (ObjectMap o) = do-    name' <- extractObject "name" o-    tpe' <- extractObject "tpe" o-    return $ AddOptions name' tpe' (extractObjectOr "activate" False o)-  fromObject o = Left ("invalid type for AddOptions: " <+> viaShow o)+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackDecode, MsgpackEncode)
+ lib/Proteome/Data/CurrentTag.hs view
@@ -0,0 +1,24 @@+module Proteome.Data.CurrentTag where++import qualified Data.List.NonEmpty.Zipper as Zipper+import Data.List.NonEmpty.Zipper (Zipper)+import Path (Abs, File, Path)++import Proteome.Tags.State (TagLoc)++data CurrentTag =+  CurrentTag {+    name :: Text,+    locations :: Zipper (TagLoc (Path Abs File))+  }+  deriving stock (Eq, Show, Generic)++pattern CurrentLoc :: TagLoc (Path Abs File) -> CurrentTag+pattern CurrentLoc loc <- (Zipper.current . locations -> loc)+{-# complete CurrentLoc #-}++cycleLoc ::+  Zipper (TagLoc (Path Abs File)) ->+  Zipper (TagLoc (Path Abs File))+cycleLoc locs =+  fromMaybe (Zipper.start locs) (Zipper.right locs)
lib/Proteome/Data/Env.hs view
@@ -1,30 +1,28 @@-{-# LANGUAGE TemplateHaskell #-}+module Proteome.Data.Env where -module Proteome.Data.Env (-  Env(..),-  _mainProject,-  _projects,-  _errors,-  _currentProjectIndex,-  _configLog,-) where+import Ribosome (Buffer) -import Control.Lens (makeClassy_)-import Data.Default.Class (Default(def))-import Ribosome.Data.Errors (Errors) import Proteome.Data.Project(Project)+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))+import Proteome.Data.ProjectType (ProjectType)+import Proteome.Data.Replace (Replace)  data Env =   Env {     mainProject :: Project,     projects :: [Project],-    errors :: Errors,     currentProjectIndex :: Int,-    configLog :: [FilePath]+    configLog :: [Text],+    buffers :: [Buffer],+    replace :: Maybe Replace   }-  deriving Show--makeClassy_ ''Env+  deriving stock (Show, Generic)+  deriving anyclass (Default) -instance Default Env where-  def = Env def def def def def+mainType :: Env -> Maybe ProjectType+mainType env =+  case env ^. (#mainProject . #meta) of+    DirProject _ _ tpe ->+      tpe+    VirtualProject _ ->+      Nothing
+ lib/Proteome/Data/FileScanItem.hs view
@@ -0,0 +1,11 @@+module Proteome.Data.FileScanItem where++import Path (Abs, Dir, File, Path)++data FileScanItem =+  FileScanItem {+    _base :: Path Abs Dir,+    _baseIndicator :: Maybe Text,+    _path :: Path Abs File+  }+  deriving stock (Eq, Show)
+ lib/Proteome/Data/FilenameError.hs view
@@ -0,0 +1,38 @@+module Proteome.Data.FilenameError where++import Exon (exon)+import Log (Severity (Error, Warn))+import Ribosome (Report (Report), Reportable (toReport))++data FilenameError =+  BadCwd+  |+  InvalidPathSpec Text+  |+  BufferPathInvalid+  |+  CreateDir Text+  |+  Exists Text+  |+  ActionFailed Text Text+  |+  Remove Text+  deriving stock (Eq, Show, Generic)++instance Reportable FilenameError where+  toReport = \case+    BadCwd ->+      Report "Could not determine current directory" ["FilenameError.BadCwd"] Error+    InvalidPathSpec spec ->+      Report [exon|Invalid path: #{spec}|] ["FilenameError.InvalidPathSpec:", spec] Warn+    BufferPathInvalid ->+      Report "Current buffer is not an existing file" ["FilenameError.BufferPathInvalid"] Warn+    CreateDir dir ->+      Report [exon|Could not create directory #{dir}|] ["FilenameError.CreateDir:", dir] Warn+    Exists file ->+      Report [exon|File already exists: #{file}|] ["FilenameError.Exists:", file] Warn+    ActionFailed action err ->+      Report "File system error" ["FilenameError.ActionFailed:", action, err] Warn+    Remove err ->+      Report "Couldn't remove the source file" ["FilenameError.Remove:", err] Warn
+ lib/Proteome/Data/FilesConfig.hs view
@@ -0,0 +1,13 @@+module Proteome.Data.FilesConfig where++import Text.Regex.PCRE.Light (Regex)++data FilesConfig =+  FilesConfig {+    useRg :: Bool,+    ignoreHidden :: Bool,+    ignoreFiles :: [Regex],+    ignoreDirs :: [Regex],+    wildignore :: [Text]+  }+  deriving stock (Eq, Show, Generic)
+ lib/Proteome/Data/FilesError.hs view
@@ -0,0 +1,28 @@+module Proteome.Data.FilesError where++import Log (Severity (Error, Warn))+import Ribosome (Report (Report), Reportable (toReport))++data FilesError =+  BadCwd+  |+  NoSuchPath Text+  |+  BadRegex Text Text+  |+  InvalidFilePath Text+  |+  CouldntCreateDir Text+  deriving stock (Eq, Show)++instance Reportable FilesError where+  toReport BadCwd =+    Report "internal error" ["FilesError.BadCwd"] Error+  toReport (NoSuchPath path) =+    Report ("path doesn't exist: " <> path) ["FilesError.NoSuchPath:", path] Warn+  toReport (BadRegex var re) =+    Report ("bad regex in `g:proteome_" <> var <> "`: " <> re) ["FilesError.BadRegex:", var, re] Warn+  toReport (InvalidFilePath path) =+    Report ("invalid file path: " <> path) ["FilesError.InvalidFilePath:", path] Warn+  toReport (CouldntCreateDir path) =+    Report ("couldn't create directory: " <> path) ["FilesError.CouldntCreateDir:", path] Warn
+ lib/Proteome/Data/FilesState.hs view
@@ -0,0 +1,76 @@+module Proteome.Data.FilesState where++import Path (Abs, File, Path, filename, parent)+import Ribosome (pathText)+import Ribosome.Menu (Filter, MenuItem (MenuItem), Modal)+import qualified Ribosome.Menu.MenuState as MenuState+import Ribosome.Menu.MenuState (FilterMode (FilterMode), MenuMode (cycleFilter, renderFilter))+import Exon (exon)++data FileSegments =+  FileSegments {+    path :: Path Abs File,+    name :: Text,+    dir :: Text+  }+  deriving stock (Eq, Show, Generic)++fileSegments :: Path Abs File -> FileSegments+fileSegments path =+  FileSegments {+    name = pathText (filename path),+    dir = pathText (parent path),+    ..+  }++data Segment =+  Full+  |+  Name+  |+  Dir+  deriving stock (Eq, Show, Ord)++renderSegment :: Segment -> Text+renderSegment = \case+  Full -> "full"+  Name -> "name"+  Dir -> "dir"++segmentExtract :: MenuItem FileSegments -> Segment -> Text+segmentExtract (MenuItem FileSegments {..} _ render) = \case+  Full -> render+  Name -> name+  Dir -> dir++cycle :: Segment -> Segment+cycle = \case+  Full -> Name+  Name -> Dir+  Dir -> Full++data FilesMode =+  FilesMode {+    mode :: Filter,+    segment :: Segment+  }+  deriving stock (Eq, Show, Ord, Generic)++type FilesState =+  Modal FilesMode FileSegments++instance MenuMode FileSegments FilesMode where+  type Filter FilesMode =+    FilterMode Filter++  cycleFilter (FilesMode mode segment) =+    FilesMode (cycleFilter mode) segment++  renderFilter (FilesMode mode _) =+    renderFilter mode++  renderExtra (FilesMode _ segment) =+    Just [exon|🔧 #{renderSegment segment}|]++  filterMode (FilesMode mode segment) =+    FilterMode mode (Just . flip segmentExtract segment)
+ lib/Proteome/Data/GrepError.hs view
@@ -0,0 +1,31 @@+module Proteome.Data.GrepError where++import Exon (exon)+import Log (Severity (Warn))+import Path (Abs, Dir, Path)+import Ribosome (Report (Report), Reportable (toReport), pathText)++data GrepError =+  Empty+  |+  NotInPath Text+  |+  NoSuchExecutable Text+  |+  NoSuchDestination (Path Abs Dir)+  |+  EmptyUserInput Text+  deriving stock (Eq, Show)++instance Reportable GrepError where+  toReport = \case+    Empty ->+      Report "grep cmdline is empty" ["GrepError.Empty"] Warn+    NotInPath exe ->+      Report ("grep executable `" <> exe <> "` not found in $PATH") ["GrepError.NotInPath:", exe] Warn+    NoSuchExecutable exe ->+      Report ("grep executable `" <> exe <> "` does not exist") ["GrepError.NoSuchExecutable:", exe] Warn+    NoSuchDestination (pathText -> dir) ->+      Report [exon|grep destination `#{dir}` does not exist|] ["GrepError.NoSuchDestination:", dir] Warn+    EmptyUserInput what ->+      Report [exon|no #{what} given|] ["GrepError.EmptyPattern"] Warn
+ lib/Proteome/Data/GrepOutputLine.hs view
@@ -0,0 +1,18 @@+module Proteome.Data.GrepOutputLine where++import Path (Abs, File, Path)+import Ribosome (MsgpackEncode)++data GrepOutputLine =+  GrepOutputLine {+    path :: Path Abs File,+    line :: Int,+    col :: Maybe Int,+    content :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackEncode)++sameLine :: GrepOutputLine -> GrepOutputLine -> Bool+sameLine (GrepOutputLine p1 l1 _ _) (GrepOutputLine p2 l2 _ _) =+  p1 == p2 && l1 == l2
+ lib/Proteome/Data/ListedBuffer.hs view
@@ -0,0 +1,11 @@+module Proteome.Data.ListedBuffer where++import Ribosome.Host.Api.Data (Buffer)++data ListedBuffer =+  ListedBuffer {+    buffer :: Buffer,+    number :: Int,+    name :: Text+  }+  deriving stock (Eq, Show, Generic)
+ lib/Proteome/Data/PersistBuffers.hs view
@@ -0,0 +1,11 @@+module Proteome.Data.PersistBuffers where++import Path (Abs, File, Path)++data PersistBuffers =+  PersistBuffers {+    current :: Maybe (Path Abs File),+    buffers :: [Path Abs File]+  }+  deriving stock (Eq, Generic, Show)+  deriving anyclass (FromJSON, ToJSON)
lib/Proteome/Data/Project.hs view
@@ -1,74 +1,10 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}--module Proteome.Data.Project(-  ProjectMetadata (..),-  Project (..),-  ProjectType (..),-  ProjectLang (..),-  ProjectRoot (..),-  ProjectName (..),-  _meta,-  _lang,-  langOrType,-) where--import GHC.Generics (Generic)-import Control.Lens (makeClassy_)-import Control.DeepSeq (NFData)-import Data.Default.Class (Default(def))-import Neovim.Classes (NvimObject(..))-import Ribosome.Internal.NvimObject (deriveString)--newtype ProjectName = ProjectName String-  deriving (Eq, Show, Generic, NFData)--instance NvimObject ProjectName where-  toObject (ProjectName s) = toObject s-  fromObject = deriveString ProjectName--newtype ProjectType =-  ProjectType {-    projectType :: String-  }-  deriving (Ord, Eq, Show, Generic, NFData)--instance NvimObject ProjectType where-  toObject (ProjectType s) = toObject s-  fromObject = deriveString ProjectType--newtype ProjectLang =-  ProjectLang-  {-    projectLang :: String-  }-  deriving (Ord, Eq, Show, Generic, NFData)--instance NvimObject ProjectLang where-  toObject (ProjectLang s) = toObject s-  fromObject = deriveString ProjectLang--newtype ProjectRoot = ProjectRoot FilePath-  deriving (Eq, Show, Generic, NFData)--instance NvimObject ProjectRoot where-  toObject (ProjectRoot s) = toObject s-  fromObject = deriveString ProjectRoot+module Proteome.Data.Project where -data ProjectMetadata =-  DirProject {-    name :: ProjectName,-    root :: ProjectRoot,-    tpe :: Maybe ProjectType-  }-  | VirtualProject {-    name :: ProjectName-  }-  deriving (Eq, Show)+import Ribosome (MsgpackDecode, MsgpackEncode) -instance Default ProjectMetadata where-  def = VirtualProject (ProjectName "main")+import Proteome.Data.ProjectLang (ProjectLang (ProjectLang))+import Proteome.Data.ProjectMetadata (ProjectMetadata)+import Proteome.Data.ProjectType (ProjectType (ProjectType))  data Project =   Project {@@ -77,12 +13,12 @@     lang :: Maybe ProjectLang,     langs :: [ProjectLang]   }-  deriving (Eq, Show)--makeClassy_ ''Project+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackDecode, MsgpackEncode)  instance Default Project where-  def = Project def def def def+  def =+    Project def def def def  langOrType :: Maybe ProjectLang -> Maybe ProjectType -> Maybe ProjectLang langOrType (Just lang') _ = Just lang'
+ lib/Proteome/Data/ProjectConfig.hs view
@@ -0,0 +1,20 @@+module Proteome.Data.ProjectConfig where++import Path (Abs, Dir, Path)+import Ribosome (MsgpackDecode, MsgpackEncode)++import Proteome.Data.ProjectLang (ProjectLang)+import Proteome.Data.ProjectType (ProjectType)++data ProjectConfig =+  ProjectConfig {+    baseDirs :: [Path Abs Dir],+    typeDirs :: Map ProjectType [Path Abs Dir],+    projectTypes :: Map ProjectType [Path Abs Dir],+    typeMap :: Map ProjectType [ProjectType],+    typeMarkers :: Map ProjectType [Text],+    langMap :: Map ProjectType ProjectLang,+    langsMap :: Map ProjectLang [ProjectLang]+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackDecode, MsgpackEncode, Default)
+ lib/Proteome/Data/ProjectLang.hs view
@@ -0,0 +1,8 @@+module Proteome.Data.ProjectLang where++import Ribosome (MsgpackDecode, MsgpackEncode)++newtype ProjectLang =+  ProjectLang { unProjectLang :: Text }+  deriving stock (Ord, Eq, Show, Generic)+  deriving newtype (MsgpackEncode, MsgpackDecode, IsString)
+ lib/Proteome/Data/ProjectMetadata.hs view
@@ -0,0 +1,24 @@+module Proteome.Data.ProjectMetadata where++import Ribosome (MsgpackDecode, MsgpackEncode)++import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectRoot (ProjectRoot)+import Proteome.Data.ProjectType (ProjectType)++data ProjectMetadata =+  DirProject {+    name :: ProjectName,+    root :: ProjectRoot,+    tpe :: Maybe ProjectType+  }+  |+  VirtualProject {+    name :: ProjectName+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackDecode, MsgpackEncode)++instance Default ProjectMetadata where+  def =+    VirtualProject (ProjectName "main")
+ lib/Proteome/Data/ProjectName.hs view
@@ -0,0 +1,8 @@+module Proteome.Data.ProjectName where++import Ribosome (MsgpackDecode, MsgpackEncode)++newtype ProjectName =+  ProjectName { unProjectName :: Text }+  deriving stock (Eq, Show, Generic)+  deriving newtype (MsgpackEncode, MsgpackDecode, IsString)
+ lib/Proteome/Data/ProjectRoot.hs view
@@ -0,0 +1,9 @@+module Proteome.Data.ProjectRoot where++import Path (Abs, Dir, Path)+import Ribosome (MsgpackDecode, MsgpackEncode)++newtype ProjectRoot =+  ProjectRoot { unProjectRoot :: Path Abs Dir }+  deriving stock (Eq, Show, Generic)+  deriving newtype (MsgpackDecode, MsgpackEncode)
lib/Proteome/Data/ProjectSpec.hs view
@@ -1,19 +1,11 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE RecordWildCards #-}+module Proteome.Data.ProjectSpec where -module Proteome.Data.ProjectSpec(-  ProjectSpec (..),-) where+import Ribosome (MsgpackDecode, MsgpackEncode) -import GHC.Generics (Generic)-import Control.DeepSeq (NFData)-import qualified Data.Map as Map (fromList)-import Data.Maybe (catMaybes)-import Data.MessagePack-import Neovim.Classes (NvimObject(..), Dictionary)-import Proteome.Data.Project (ProjectName, ProjectType, ProjectLang, ProjectRoot)+import Proteome.Data.ProjectLang (ProjectLang)+import Proteome.Data.ProjectName (ProjectName)+import Proteome.Data.ProjectRoot (ProjectRoot)+import Proteome.Data.ProjectType (ProjectType)  data ProjectSpec =   ProjectSpec {@@ -24,18 +16,5 @@     lang :: Maybe ProjectLang,     langs :: [ProjectLang]   }-  deriving (Generic, NFData)--instance NvimObject ProjectSpec where-  toObject ProjectSpec {..} =-    (toObject :: Dictionary -> Object) . Map.fromList $-    [-      ("name", toObject name),-      ("root", toObject root),-      ("types", toObject types),-      ("langs", toObject langs)-    ] ++ catMaybes-    [-      tpe >>= \a -> return ("tpe", toObject a),-      lang >>= \a -> return ("lang", toObject a)-    ]+  deriving stock (Eq, Show, Generic)+  deriving anyclass (MsgpackDecode, MsgpackEncode)
+ lib/Proteome/Data/ProjectType.hs view
@@ -0,0 +1,8 @@+module Proteome.Data.ProjectType where++import Ribosome (MsgpackDecode, MsgpackEncode)++newtype ProjectType =+  ProjectType { unProjectType :: Text }+  deriving stock (Ord, Eq, Show, Generic)+  deriving newtype (MsgpackDecode, MsgpackEncode, IsString)
− lib/Proteome/Data/Proteome.hs 
@@ -1,9 +0,0 @@-module Proteome.Data.Proteome(-  Proteome-) where--import UnliftIO.STM (TVar)-import Ribosome.Control.Ribo (Ribo)-import Proteome.Data.Env (Env)--type Proteome a = Ribo (TVar Env) a
+ lib/Proteome/Data/Replace.hs view
@@ -0,0 +1,13 @@+module Proteome.Data.Replace where++import Prelude hiding (lines)+import Ribosome (ScratchState)++import Proteome.Data.GrepOutputLine (GrepOutputLine)++data Replace =+  Replace {+    scratch :: ScratchState,+    lines :: NonEmpty GrepOutputLine+  }+  deriving stock (Eq, Show, Generic)
+ lib/Proteome/Data/ReplaceError.hs view
@@ -0,0 +1,18 @@+module Proteome.Data.ReplaceError where++import Log (Severity (Error, Warn))+import Path (Abs, File, Path)+import Ribosome (Report (Report), Reportable, toReport)+import Ribosome (pathText)++data ReplaceError =+  BadReplacement+  |+  CouldntLoadBuffer (Path Abs File)+  deriving stock (Eq, Show)++instance Reportable ReplaceError where+  toReport BadReplacement =+    Report "replacment line count does not match original" ["ReplaceError.BadReplacement"] Warn+  toReport (CouldntLoadBuffer (pathText -> path)) =+    Report ("could not load file " <> path) ["ReplaceError.CouldntLoadBuffer", path] Error
+ lib/Proteome/Data/ResolveError.hs view
@@ -0,0 +1,13 @@+module Proteome.Data.ResolveError where++import Exon (exon)+import Log (Severity (Warn))+import Ribosome (Report (Report), Reportable (toReport))++newtype ResolveError =+  ParsePath Text+  deriving stock (Eq, Show)++instance Reportable ResolveError where+  toReport (ParsePath path) =+    Report [exon|invalid path: #{path}|] ["ResolveError.ParsePath:", path] Warn
+ lib/Proteome/Data/TagsError.hs view
@@ -0,0 +1,26 @@+module Proteome.Data.TagsError where++import Exon (exon)+import Log (Severity (Warn))+import Ribosome (Report (Report), Reportable (toReport), SettingError, reportMessages)++data TagsError =+  Process Text+  |+  TempName+  |+  RenameTags Text+  |+  Setting SettingError+  deriving stock (Eq, Show)++instance Reportable TagsError where+  toReport = \case+    Process msg ->+      Report "tags process failed" ["TagsError.Process", msg] Warn+    TempName ->+      Report "failed to create temp dir for tags process" ["TagsError.TempName"] Warn+    RenameTags msg ->+      Report "Failed to rename temporary tags file" ["TagsError.RenameTags", msg] Warn+    Setting e ->+      Report [exon|tags failed: #{reportMessages (toReport e)}|] ["TagsError.Setting:", show e] Warn
+ lib/Proteome/Data/TagsParams.hs view
@@ -0,0 +1,11 @@+module Proteome.Data.TagsParams where++import Proteome.Data.ProjectLang (ProjectLang)+import Proteome.Data.ProjectRoot (ProjectRoot)++data TagsParams =+  TagsParams {+    root :: ProjectRoot,+    langs :: [ProjectLang]+  }+  deriving stock (Eq, Show)
lib/Proteome/Diag.hs view
@@ -1,96 +1,141 @@-module Proteome.Diag(-  proDiag,-) where+module Proteome.Diag where -import Data.Functor (void)-import Data.List (intercalate)-import Data.Map (foldMapWithKey)-import Neovim (CommandArguments)-import Ribosome.Data.ScratchOptions (defaultScratchOptions)-import Ribosome.Data.Errors (Error(Error), Errors(Errors), ComponentName(ComponentName))-import Ribosome.Scratch (showInScratch)-import qualified Ribosome.Control.Ribo as Ribo (inspect)-import Proteome.Env (getMainProject)-import qualified Proteome.Data.Env as Env (configLog, projects, errors)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  Project (Project),-  ProjectLang(..),-  ProjectRoot(ProjectRoot),-  ProjectName(ProjectName),-  ProjectType(..),-  ProjectMetadata (DirProject, VirtualProject),+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Exon (exon)+import Path (toFilePath)+import Prettyprinter (Doc, line, nest, pretty, vsep)+import Ribosome (+  Handler,+  Report (Report),+  ReportContext,+  Reports,+  RpcError,+  Scratch,+  ScratchId (ScratchId),+  Settings,+  StoredReport (StoredReport),+  reportContext,+  resumeReport,+  scratch,+  storedReports,   )-import Proteome.Tags (tagsCommand)+import qualified Ribosome.Scratch as Scratch+import Ribosome.Scratch (ScratchOptions (filetype, focus)) -formatLang :: Maybe ProjectLang -> String+import qualified Proteome.Data.Env as Env+import Proteome.Data.Env (Env)+import Proteome.Data.Project (Project (Project))+import Proteome.Data.ProjectLang (ProjectLang (ProjectLang, unProjectLang))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))+import Proteome.Data.ProjectType (ProjectType (ProjectType, unProjectType))+import Proteome.Tags.Gen (tagsCommand)++formatLang :: Maybe ProjectLang -> Text formatLang (Just (ProjectLang lang)) = lang formatLang Nothing = "none" -formatType :: Maybe ProjectType -> String+formatType :: Maybe ProjectType -> Text formatType (Just (ProjectType tpe)) = tpe formatType Nothing = "none" -formatMeta :: ProjectMetadata -> [ProjectLang] -> Proteome [String]-formatMeta (VirtualProject (ProjectName name)) _ = return ["name: " ++ name]-formatMeta (DirProject (ProjectName name) r@(ProjectRoot root) tpe) langs = do-  (tagsCmd, tagsArgs) <- tagsCommand r langs-  return [-    "name: " ++ name,-    "root: " ++ root,-    "type: " ++ formatType tpe,-    "tags cmd: " ++ tagsCmd ++ " " ++ tagsArgs-    ]+formatProject :: ProjectName -> ProjectRoot -> Maybe ProjectType -> [Text]+formatProject (ProjectName name) (ProjectRoot root) tpe =+  [+    "name: " <> name,+    "root: " <> (toText . toFilePath) root,+    "type: " <> formatType tpe+  ] -formatMain :: Project -> Proteome [String]+formatMeta ::+  Member (Settings !! se) r =>+  ProjectMetadata ->+  [ProjectLang] ->+  Sem r [Text]+formatMeta (VirtualProject (ProjectName name)) _ =+  pure ["name: " <> name]+formatMeta (DirProject name root tpe) langs = do+  tags :: [Text] <- resumeAs [] do+    runStop (tagsCommand root langs) >>= \case+      Right (tagsCmd, tagsArgs) ->+        pure [[exon|tags cmd: #{tagsCmd} #{tagsArgs}|]]+      Left _ ->+        pure []+  pure (formatProject name root tpe <> tags)++formatMain ::+  Member (Settings !! se) r =>+  Project ->+  Sem r [Text] formatMain (Project meta types lang langs) = do   metaContent <- formatMeta meta langs-  return $ metaContent ++ [-    "types: " ++ intercalate ", " (fmap projectType types),-    "main language: " ++ formatLang lang,-    "languages: " ++ intercalate ", " (fmap projectLang langs)+  pure $ metaContent <> [+    "types: " <> Text.intercalate ", " (unProjectType <$> types),+    "main language: " <> formatLang lang,+    "languages: " <> Text.intercalate ", " (unProjectLang <$> langs)     ] -formatExtraProjects :: [Project] -> Proteome [String]+formatExtraProjects ::+  Member (Settings !! se) r =>+  [Project] ->+  Sem r [Text] formatExtraProjects projects = do   formatted <- traverse formatMain projects-  return $ ["", "Extra projects", ""] ++ intercalate [""] formatted+  pure $ ["", "Extra projects", ""] <> intercalate [""] formatted -formatExtraProjectsIfNonempty :: Proteome [String]+formatExtraProjectsIfNonempty ::+  Members [Settings !! se, AtomicState Env] r =>+  Sem r [Text] formatExtraProjectsIfNonempty = do-  projects <- Ribo.inspect Env.projects+  projects <- atomicGets Env.projects   case projects of     _ : _ -> formatExtraProjects projects-    _ -> return []--formatError :: Error -> [String]-formatError (Error stamp (first:message)) = (show stamp ++ " | " ++ first) : message-formatError _ = []+    _ -> pure [] -formatComponentErrors :: ComponentName -> [Error] -> [String]-formatComponentErrors (ComponentName name) errors@(_ : _) =-  [name ++ "", ""] ++ (errors >>= formatError)-formatComponentErrors _ _ = []+storedError :: StoredReport -> Doc a+storedError (StoredReport (Report _ log _) _) =+  case log of+    [] -> mempty+    (h : t) ->+      nest 2 (vsep (pretty <$> ([exon|* #{h}|] : t))) +tagErrors :: ReportContext -> [StoredReport] -> Doc a+tagErrors ctx errs =+  pretty [exon|### #{reportContext ctx}|] <> line <> vsep (storedError <$> errs) -formatErrorLog :: Errors -> [String]-formatErrorLog (Errors errors) =-  case compErrors of-    _ : _ -> ["", "Errors", ""] ++ compErrors-    _ -> []-  where-    compErrors = foldMapWithKey formatComponentErrors errors+errorDiagnostics :: Map ReportContext [StoredReport] -> Doc a+errorDiagnostics errs | null errs =+  mempty+errorDiagnostics errs =+  "## Reports" <> line <> line <> vsep (uncurry tagErrors <$> Map.toAscList errs) -diagnostics :: Proteome [String]+diagnostics ::+  Members [Settings !! se, AtomicState Env, Reports] r =>+  Sem r [Text] diagnostics = do-  main <- getMainProject >>= formatMain+  main <- formatMain =<< atomicGets Env.mainProject   extra <- formatExtraProjectsIfNonempty-  confLog <- Ribo.inspect Env.configLog-  errors <- Ribo.inspect Env.errors-  return $ ["Diagnostics", "", "Main project", ""] ++ main ++ extra ++ ["", "loaded config files:"] ++-    confLog ++ formatErrorLog errors+  confLog <- atomicGets Env.configLog+  errors <- errorDiagnostics <$> storedReports+  pure $ header <> main <> extra <> ["", "loaded config files:"] <> confLog <> Text.lines (show errors)+  where+    header =+      ["Diagnostics", "", "Main project", ""] -proDiag :: CommandArguments -> Proteome ()-proDiag _ = do-  content <- diagnostics-  void $ showInScratch content (defaultScratchOptions "proteome-diagnostics")+proDiag ::+  Members [Settings !! se, Scratch !! RpcError, AtomicState Env, Reports] r =>+  Handler r ()+proDiag = do+  resumeReport @Scratch do+    content <- diagnostics+    void $ Scratch.show content options+  where+    options =+      (scratch (ScratchId name)) {+        focus = True,+        filetype = Just name+      }+    name =+      "proteome-diagnostics"
− lib/Proteome/Env.hs 
@@ -1,12 +0,0 @@-module Proteome.Env(-  getMainProject,-) where--import qualified Ribosome.Control.Ribo as Ribo (inspect)-import qualified Proteome.Data.Env as Env (mainProject)-import Proteome.Data.Project(Project)-import Proteome.Data.Proteome (Proteome)--getMainProject :: Proteome Project-getMainProject =-  Ribo.inspect Env.mainProject
+ lib/Proteome/Filename.hs view
@@ -0,0 +1,417 @@+module Proteome.Filename where++import qualified Chronos+import qualified Data.Text as Text+import Exon (exon)+import Path (+  Abs,+  Dir,+  File,+  Path,+  Rel,+  addExtension,+  dirname,+  filename,+  parent,+  parseRelDir,+  reldir,+  relfile,+  splitExtension,+  (</>),+  )+import Path.IO (copyFile, doesDirExist, doesFileExist, ensureDir, removeFile)+import Ribosome (+  Bang (Bang),+  Handler,+  LogReport,+  Rpc,+  RpcError,+  logReport,+  mapReport,+  pathText,+  resumeReport,+  rpcError,+  )+import Ribosome.Api (bufferSetName, vimCallFunction, vimCommand, vimGetCurrentBuffer, wipeBuffer)+import Ribosome.Api.Buffer (currentBufferName, edit)+import Ribosome.Api.Path (nvimCwd)+import Ribosome.Data.PersistPathError (PersistPathError)+import Ribosome.Host.Modify (silent)+import Ribosome.Persist (PersistPath, persistPath)++import qualified Proteome.Data.FilenameError as FilenameError+import Proteome.Data.FilenameError (FilenameError)+import Proteome.Path (+  absoluteParse,+  absoluteParseDir,+  parseAbsDirMaybe,+  parseAbsFileMaybe,+  parseRelDirMaybe,+  parseRelFileMaybe,+  )++data BufPath =+  BufPath (Path Abs File) [Text]+  deriving stock (Eq, Show)++bufDir :: BufPath -> Path Abs Dir+bufDir (BufPath f _) =+  parent f++data NameSpec =+  Star (Path Rel File)+  |+  Literal (Path Rel File)+  deriving stock (Eq, Show)++rawNameSpec ::+  NameSpec ->+  Path Rel File+rawNameSpec = \case+  Star f -> f+  Literal f -> f++data Modification =+  Filename (Path Rel File) (Path Rel Dir) NameSpec [Text]+  |+  Dir (Path Abs Dir)+  |+  File (Path Abs File)+  |+  Container Int (Path Rel Dir)+  deriving stock (Eq, Show)++nameSpec :: Path Rel File -> NameSpec+nameSpec p =+  if p == [relfile|*|] then Star p else Literal p++dotsInPath :: Text -> Int+dotsInPath path =+  Text.length (Text.filter (== '.') (Text.drop 1 path))++absoluteDir :: Text -> Maybe Modification+absoluteDir =+  fmap Dir . parseAbsDirMaybe++absoluteFile :: Text -> Maybe Modification+absoluteFile =+  fmap File . parseAbsFileMaybe++relativeDir :: Path Abs Dir -> Text -> Maybe Modification+relativeDir cwd spec = do+  rel <- parseRelDirMaybe spec+  pure (Dir (cwd </> rel))++relativeFile :: Path Abs Dir -> Text -> Maybe Modification+relativeFile cwd spec = do+  rel <- parseRelFileMaybe spec+  pure (File (cwd </> rel))++splitExtensions :: Path b File -> (Path b File, [Text])+splitExtensions =+  spin []+  where+    spin exts f =+      case splitExtension f of+        Just (f', e) -> spin (toText e : exts) f'+        Nothing -> (f, exts)++addExtensions ::+  Path b File ->+  [Text] ->+  Maybe (Path b File)+addExtensions name exts =+  foldlM (flip addExtension) name (toString <$> exts)++nameOnly :: Text -> Maybe Modification+nameOnly spec = do+  rel <- parseRelFileMaybe spec+  let (name, exts) = splitExtensions (filename rel)+  Just (Filename rel (parent rel) (nameSpec name) exts)++maybeDir ::+  Member (Embed IO) r =>+  Path Abs Dir ->+  Text ->+  Sem r Bool+maybeDir cwd spec =+  fromMaybe False <$> traverse doesDirExist (absoluteParseDir cwd spec)++regularModification ::+  Members [Stop FilenameError, Embed IO] r =>+  Path Abs Dir ->+  Text ->+  Sem r Modification+regularModification cwd spec = do+  existingDir <- maybeDir cwd spec+  stopNote (FilenameError.InvalidPathSpec spec) (cons existingDir spec)+  where+    cons existingDir+      | name = nameOnly+      | absolute = if explicitDir || existingDir then absoluteDir else absoluteFile+      | explicitDir = relativeDir cwd+      | otherwise = relativeFile cwd+    name =+      not (Text.any ('/' ==) spec)+    absolute =+      Text.take 1 spec == "/"+    explicitDir =+      Text.takeEnd 1 spec == "/"++directorySelector :: Text -> (Int, Text)+directorySelector =+  first Text.length . Text.span ('^' ==)++modification ::+  Members [Stop FilenameError, Embed IO] r =>+  Bool ->+  Path Abs Dir ->+  Text ->+  Sem r Modification+modification raw cwd (Text.strip -> spec) =+  case directorySelector spec of+    (n, _) | n == 0 || raw ->+      regularModification cwd spec+    (n, name) -> do+      dir <- stopNote (FilenameError.InvalidPathSpec name) (parseRelDir (toString name))+      pure (Container n dir)++checkBufferPath ::+  Members [Rpc, Stop FilenameError, Embed IO] r =>+  Path Abs Dir ->+  Sem r (Path Abs File)+checkBufferPath cwd = do+  name <- currentBufferName+  path <- stopNote FilenameError.BufferPathInvalid (absoluteParse cwd name)+  ifM (doesFileExist path) (pure path) (stop FilenameError.BufferPathInvalid)++withExtension ::+  BufPath ->+  [Text] ->+  NameSpec ->+  Maybe (Path Rel File)+withExtension (BufPath bufName bufExts) exts = \case+  Star _ ->+    addExtensions (filename bufName) (take (length bufExts - length exts) bufExts ++ exts)+  Literal name ->+    addExtensions name (exts ++ drop (length exts) bufExts)++renameInplace ::+  Member (Stop FilenameError) r =>+  Bool ->+  Path Rel File ->+  BufPath ->+  Path Rel Dir ->+  NameSpec ->+  [Text] ->+  Sem r (Path Abs File)+renameInplace raw spec bufPath destDir newName exts = do+  rel <-+    if raw+    then pure (destDir </> spec)+    else stopNote FilenameError.BufferPathInvalid (withExtension bufPath exts newName)+  pure (bufDir bufPath </> rel)++replaceDir ::+  Member (Stop FilenameError) r =>+  Int ->+  Path Rel Dir ->+  Path Abs File ->+  Sem r (Path Abs File)+replaceDir index name file = do+  dir <- spin (parent file) index+  pure (dir </> filename file)+  where+    spin d _ | parent d == d =+      stop (FilenameError.InvalidPathSpec "not enough directory segments in buffer path")+    spin d i | i <= 1 =+      pure (parent d </> name)+    spin d i = do+      sub <- spin (parent d) (i - 1)+      pure (sub </> dirname d)++assemblePath ::+  Member (Stop FilenameError) r =>+  Bool ->+  Path Abs File ->+  Modification ->+  Sem r (Path Abs File)+assemblePath raw bufPath = \case+  Filename rawSpec destDir newName exts ->+    renameInplace raw rawSpec (uncurry BufPath (splitExtensions bufPath)) destDir newName exts+  Dir dir ->+    pure (dir </> filename bufPath)+  File file ->+    pure file+  Container index name ->+    replaceDir index name bufPath++ensureDestinationEmpty ::+  Members [Stop FilenameError, Embed IO] r =>+  Path Abs File ->+  Sem r ()+ensureDestinationEmpty path =+  whenM (doesFileExist path) (stop (FilenameError.Exists (pathText path)))++prepareDestination ::+  Members [Stop FilenameError, Embed IO] r =>+  Path Abs File ->+  Sem r ()+prepareDestination path =+  ifM exists (ensureDestinationEmpty path) create+  where+    exists =+      doesDirExist dir+    create =+      stopTryAny (const (FilenameError.CreateDir (pathText dir))) (ensureDir dir)+    dir =+      parent path++getCwd ::+  Members [Stop FilenameError, Rpc !! RpcError] r =>+  Sem r (Path Abs Dir)+getCwd =+  resumeHoistAs FilenameError.BadCwd nvimCwd++smartModification ::+  Members [Stop FilenameError, Rpc !! RpcError, Embed IO] r =>+  Bool ->+  Text ->+  Sem r Modification+smartModification raw spec = do+  cwd <- getCwd+  modification raw cwd spec++trashModification ::+  Members [Stop FilenameError, Rpc, Rpc !! RpcError, PersistPath, Embed IO] r =>+  Sem r Modification+trashModification = do+  cwd <- getCwd+  bufPath <- checkBufferPath cwd+  let original = pathText (filename bufPath)+  Chronos.Time stamp <- liftIO Chronos.now+  trashFile <- stopNote FilenameError.BufferPathInvalid (parseRelFileMaybe [exon|#{show stamp}_#{original}|])+  trashDir <- persistPath (Just [reldir|trash|])+  let trashPath = trashDir </> trashFile+  stopTryAny (const (FilenameError.CreateDir (pathText trashDir))) (ensureDir trashDir)+  pure (File trashPath)++pathsForMod ::+  Members [Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>+  Bool ->+  Modification ->+  Sem r (Path Abs File, Path Abs File)+pathsForMod raw modi = do+  cwd <- getCwd+  bufPath <- checkBufferPath cwd+  path <- assemblePath raw bufPath modi+  prepareDestination path+  pure (bufPath, path)++writeBuffer ::+  Members [Stop FilenameError, Rpc !! RpcError] r =>+  Text ->+  Sem r ()+writeBuffer action =+  err "Couldn't write buffer" $ silent do+    vimCommand "write!"+  where+    err msg =+      resumeHoist \ e -> FilenameError.ActionFailed action [exon|#{msg}: #{rpcError e}|]++updateBuffer ::+  Member Rpc r =>+  Path Abs File ->+  Sem r ()+updateBuffer path = do+  buf <- vimGetCurrentBuffer+  bufferSetName buf (pathText path)+  silent do+    vimCommand "write!"++relocate ::+  Members [Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>+  Bool ->+  Modification ->+  (Path Abs File -> Path Abs File -> Sem r ()) ->+  Sem r ()+relocate raw modi run = do+  (bufPath, destPath) <- pathsForMod raw modi+  run bufPath destPath++copyOrFail ::+  Members [Stop FilenameError, Embed IO] r =>+  Path Abs File ->+  Path Abs File ->+  Sem r ()+copyOrFail src dest =+  stopEitherWith copyFailed =<< tryAny (copyFile src dest)+  where+    copyFailed e =+      FilenameError.ActionFailed "move" [exon|Couldn't copy file: #{e}|]++moveFile ::+  Members [Stop FilenameError, DataLog LogReport, Embed IO] r =>+  Path Abs File ->+  Path Abs File ->+  Sem r ()+moveFile src dest = do+  copyOrFail src dest+  leftA (logReport . FilenameError.Remove) =<< tryAny (removeFile src)++move ::+  Members [Stop FilenameError, DataLog LogReport, Rpc, Rpc !! RpcError, Embed IO] r =>+  Bool ->+  Modification ->+  Sem r ()+move raw modi = do+  relocate raw modi \ buf dest -> do+    writeBuffer "move"+    moveFile buf dest+    updateBuffer dest++copy ::+  Members [Stop FilenameError, Rpc, Rpc !! RpcError, Embed IO] r =>+  Bool ->+  Modification ->+  Sem r ()+copy raw modi =+  relocate raw modi \ src dest -> do+    copyOrFail src dest+    view <- vimCallFunction "winsaveview" []+    edit dest+    vimCallFunction "winrestview" [view]++proMove ::+  Members [DataLog LogReport, Rpc !! RpcError, Embed IO] r =>+  Bang ->+  Text ->+  Handler r ()+proMove bang spec =+  mapReport @FilenameError $ resumeReport @Rpc do+    move raw =<< smartModification raw spec+  where+    raw =+      bang == Bang++proCopy ::+  Members [Rpc !! RpcError, Embed IO] r =>+  Bang ->+  Text ->+  Handler r ()+proCopy bang spec =+  mapReport @FilenameError $ resumeReport @Rpc do+    copy raw =<< smartModification raw spec+  where+    raw =+      bang == Bang++proRemove ::+  Members [Rpc !! RpcError, PersistPath !! PersistPathError, DataLog LogReport, Embed IO] r =>+  Handler r ()+proRemove =+  mapReport @FilenameError $ resumeReport @Rpc $ resumeReport @PersistPath do+    move False =<< trashModification+    buf <- vimGetCurrentBuffer+    resume_ @RpcError do+      wipeBuffer buf
+ lib/Proteome/Files.hs view
@@ -0,0 +1,313 @@+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 (Eq, Show)++editFile ::+  MenuWidget FilesState r FileAction+editFile =+  withSelection (pure . Edit . fmap (view #path))++matchingDirs ::+  Member (Embed IO) r =>+  [Path Abs Dir] ->+  Path Rel Dir ->+  Sem r [Path Abs Dir]+matchingDirs bases path =+  filterM (fmap (fromRight False) . tryAny . doesDirExist) ((</> path) <$> bases)++dirsWithPrefix ::+  Member (Embed IO) r =>+  Text ->+  Path Abs Dir ->+  Sem r [Path Rel Dir]+dirsWithPrefix (Text.toLower -> prefix) dir =+  filter (Text.isPrefixOf prefix . Text.toLower . toText . toFilePath) . fst <$> listDirRel dir++-- |Search all dirs in @bases@ for relative paths starting with @text@.+-- First, split the last path segment (after /) off and collect the subdirectories of @bases@ that start with the+-- remainder. If there is no / in the text, parsing the remainder fails with 'Nothing' and the @bases@ themselves are+-- used.+-- Then, search the resulting dirs for subdirs starting with the last segment.+-- Return the remainder and the relative subdir paths.+matchingPaths ::+  Member (Embed IO) r =>+  [Path Abs Dir] ->+  Text ->+  Sem r (Text, [Path Rel Dir])+matchingPaths bases text' =+  (subpath,) . join <$> (traverse (dirsWithPrefix prefix) =<< dirs)+  where+    subpath =+      maybe "" (toText . toFilePath) dir+    dirs =+      maybe (pure bases) (matchingDirs bases) dir+    (dir, prefix) =+      first (parseRelDir . toString) $ Text.breakOnEnd "/" text'++commonPrefix :: [Text] -> Maybe Text+commonPrefix (h : t) =+  foldM (\ p a -> view _1 <$> Text.commonPrefixes p a) h t+commonPrefix a =+  listToMaybe a++tabComplete ::+  Member (Embed IO) r =>+  [Path Abs Dir] ->+  Text ->+  Sem r (Maybe Text)+tabComplete bases promptText = do+  existingBases <- filterM doesDirExist bases+  (subpath, paths) <- matchingPaths existingBases promptText+  pure (mappend subpath <$> commonPrefix (toText . toFilePath <$> paths))++tabUpdatePrompt ::+  PromptMode ->+  Text ->+  Prompt+tabUpdatePrompt st prefix =+  Prompt (Text.length prefix) st (PromptText prefix)++tab ::+  Member (Embed IO) r =>+  [Path Abs Dir] ->+  MenuWidget FilesState r FileAction+tab bases = do+  Prompt _ promptState (PromptText promptText) <- ask+  tabComplete bases promptText >>= \case+    Just prefix ->+      menuUpdatePrompt (tabUpdatePrompt promptState prefix)+    Nothing ->+      menuOk++createAndEditFile ::+  Members [Rpc, Stop FilesError, Embed IO] r =>+  Path Abs File ->+  Sem r ()+createAndEditFile path = do+  stopTryAny (const err) create+  edit path+  where+    err =+      FilesError.CouldntCreateDir (toText (toFilePath dir))+    create =+      createDirIfMissing True dir+    dir =+      parent path++existingSubdirCount ::+  Member (Embed IO) r =>+  [Text] ->+  Path Abs Dir ->+  Sem r Int+existingSubdirCount =+  loop 0+  where+    loop count [] _ =+      pure count+    loop count (h : t) dir =+      case parseRelDir (toString h) of+        Right f ->+          ifM (doesDirExist sub) (loop (count + 1) t sub) (pure count)+          where sub = dir </> f+        Left _ ->+          pure count++createFile ::+  Member (Reader Prompt) r =>+  Members [Stop FilesError, Embed IO] r =>+  NonEmpty (Path Abs Dir) ->+  Sem r (Maybe (MenuAction FileAction))+createFile bases = do+  PromptText promptText <- view #text <$> ask+  let+    parse counts =+      (base counts </>) <$> parseRelFile (toString promptText)+  subdirCounts <- traverse (existingSubdirCount (dirSegments promptText)) bases+  maybe (err promptText) (menuSuccess . Create) (parse subdirCounts)+  where+    base counts =+      fst $ maximumOn1 snd (NonEmpty.zip bases counts)+    dirSegments =+      dropEnd 1 . Text.splitOn "/"+    err =+      stop . FilesError.InvalidFilePath++cycleSegment :: MenuWidget FilesState r FileAction+cycleSegment =+  menuState do+    mode . #segment %= FilesState.cycle+    menuOk++actions ::+  Members [Stop FilesError, Embed IO] r =>+  NonEmpty (Path Abs Dir) ->+  Mappings FilesState r FileAction+actions bases =+  [+    (withInsert "<cr>", editFile),+    (insert "<tab>", tab (NonEmpty.toList bases)),+    (insert "<c-y>", createFile bases),+    (insert "<c-s>", cycleSegment)+  ]++parsePath :: Path Abs Dir -> Text -> Maybe (Path Abs Dir)+parsePath _ path | Text.take 1 path == "/" =+  parseAbsDir (toString path)+parsePath cwd path =+  (cwd </>) <$> parseRelDir (toString path)++readRegex ::+  Member (Stop FilesError) r =>+  Text ->+  Text ->+  Sem r Regex+readRegex name rgx =+  stopNote (FilesError.BadRegex name rgx) (eitherToMaybe (compileM (encodeUtf8 rgx) mempty))++readRegexs ::+  Members [Settings, Stop FilesError] r =>+  Setting [Text] ->+  Sem r [Regex]+readRegexs s@(Setting name _ _) =+  traverse (readRegex name) =<< Settings.get s++filesConfig ::+  Members [Rpc, Settings, Stop FilesError] r =>+  Sem r FilesConfig+filesConfig =+  FilesConfig <$> useRg <*> hidden <*> fs <*> dirs <*> wildignore+  where+    useRg =+      Settings.get Settings.filesUseRg+    hidden =+      Settings.get Settings.filesExcludeHidden+    fs =+      readRegexs Settings.filesExcludeFiles+    dirs =+      readRegexs Settings.filesExcludeDirectories+    wildignore =+      Text.splitOn "," <$> nvimGetOption "wildignore"++fileAction ::+  Members [Rpc, Stop FilesError, Stop Report, Embed IO] r =>+  FileAction ->+  Sem r ()+fileAction = \case+  Create path ->+    createAndEditFile path+  Edit paths ->+    traverse_ edit paths+  NoAction ->+    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 ()+filesMenu cwd pathSpecs = do+  mapReport @RpcError do+    conf <- filesConfig+    items <- fmap (fmap fileSegments) <$> files conf nePaths+    result <- windowMenu items (modal (FilesMode Fuzzy Full)) window (actions nePaths)+    handleResult fileAction result+  where+    window =+      def & #prompt .~ OnlyInsert & #items .~ opt+    opt =+      def {+        name = ScratchId name,+        syntax = [filesSyntax],+        filetype = Just name+      }+    name =+      "proteome-files"+    nePaths =+      fromMaybe (cwd :| []) (nonEmpty absPaths)+    absPaths =+      mapMaybe (parsePath cwd) pathSpecs++proFiles ::+  Members FilesStack r =>+  Members [Rpc !! RpcError, Settings !! SettingError] r =>+  ArgList ->+  Handler r ()+proFiles (ArgList paths) =+  mapReport @FilesError $ resumeReport @Rpc $ resumeReport @Settings do+    cwd <- resumeHoistAs FilesError.BadCwd nvimCwd+    filesMenu cwd paths
+ lib/Proteome/Files/Source.hs view
@@ -0,0 +1,231 @@+module Proteome.Files.Source where++import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TMChan (TMChan, closeTMChan, newTMChan, readTMChan, writeTMChan)+import Control.Lens.Regex.Text (match, regexing)+import qualified Data.List.NonEmpty as NonEmpty (toList, zip)+import qualified Data.Set as Set (fromList, toList)+import qualified Data.Text as Text+import Exon (exon)+import Path (+  Abs,+  Dir,+  File,+  Path,+  Rel,+  dirname,+  filename,+  isProperPrefixOf,+  parent,+  parseAbsFile,+  relfile,+  stripProperPrefix,+  toFilePath,+  )+import Path.IO (doesDirExist, findExecutable, walkDir)+import qualified Path.IO as WalkAction (WalkAction (WalkExclude))+import Ribosome (pathText)+import Ribosome.Menu (MenuItem (MenuItem))+import Ribosome.Menu.Stream.Util (takeUntilNothing)+import qualified Streamly.Prelude as Stream+import Streamly.Prelude (IsStream, SerialT)+import System.FilePattern ((?==))+import Text.Regex.PCRE.Light (Regex)++import Proteome.Data.FileScanItem (FileScanItem (FileScanItem))+import Proteome.Data.FilesConfig (FilesConfig (FilesConfig))+import Proteome.Grep.Process (processLines)+import Proteome.Path (dropSlash)++-- TODO store traversals instead of Regexes?+matchPath :: [Regex] -> Path Abs t -> Bool+matchPath excludes path =+  any check excludes+  where+    check rgx =+      pathText path & has (regexing rgx . match)++hiddenFilter ::+  (Path Abs t -> Path Rel t) ->+  Bool ->+  Path Abs t ->+  Bool+hiddenFilter lastSegment True =+  Text.isPrefixOf "." . toText . toFilePath . lastSegment+hiddenFilter _ False =+  const False++filterFiles ::+  Bool ->+  [Regex] ->+  [String] ->+  [Path Abs File] ->+  [Path Abs File]+filterFiles excludeHidden patterns wildignore =+  filter (not . cond)+  where+    cond path =+      matchPath patterns path ||+      hiddenFilter filename excludeHidden path ||+      any (?== name) wildignore+      where+        name =+          toFilePath (filename path)++filterDirs ::+  Bool ->+  [Regex] ->+  [Path Abs Dir] ->+  [Path Abs Dir]+filterDirs excludeHidden patterns =+  filter pred'+  where+    pred' a =+      matchPath patterns a || hiddenFilter dirname excludeHidden a++scan ::+  Member (Embed IO) r =>+  FilesConfig ->+  TMChan FileScanItem ->+  Path Abs Dir ->+  Maybe Text ->+  Sem r ()+scan (FilesConfig _ excludeHidden ignoreFiles ignoreDirs wildignore) chan dir baseIndicator =+  tryAny_ do+    walkDir enqueue dir+  where+    enqueue _ dirs files' =+      exclude <$ atomically (traverse_ (writeTMChan chan) filteredFiles)+      where+        filteredFiles =+          cons <$> filterFiles excludeHidden ignoreFiles (toString <$> wildignore) files'+        exclude =+          WalkAction.WalkExclude (filterDirs excludeHidden ignoreDirs dirs)+    cons =+      FileScanItem dir baseIndicator++runScanners ::+  Members [Async, Embed IO] r =>+  FilesConfig ->+  TMChan FileScanItem ->+  NonEmpty (Path Abs Dir, Maybe Text) ->+  Sem r ()+runScanners conf chan paths = do+  threads <- traverse (async . uncurry (scan conf chan)) paths+  traverse_ await threads <* embed (atomically (closeTMChan chan))++withBaseIndicators ::+  NonEmpty (Path Abs Dir) ->+  NonEmpty (Path Abs Dir, Maybe Text)+withBaseIndicators bases@(_ :| []) =+  (, Nothing) <$> bases+withBaseIndicators bases =+  NonEmpty.zip bases (findSegment bases)+  where+    findSegment paths+      | namesUnique paths = Just . dropSlash . dirname <$> paths+      | allEqual next = Nothing <$ paths+      | otherwise = findSegment next+      where+          next = parent <$> paths+    namesUnique paths =+      uniq names == NonEmpty.toList names+      where+        names = dirname <$> paths+    allEqual paths =+      length (uniq paths) == 1+    uniq as =+      Set.toList (Set.fromList (NonEmpty.toList as))++fileMenuItem ::+  Path Abs Dir ->+  Maybe Text ->+  Path Abs File ->+  MenuItem (Path Abs File)+fileMenuItem base baseIndicator path =+  MenuItem path text display+  where+    display =+      " * " <> maybe "" indicator baseIndicator <> text+    text =+      toText (maybe (toFilePath path) toFilePath relativePath)+    relativePath =+      stripProperPrefix base path+    indicator name =+      "[" <> name <> "] "++chanStream ::+  IsStream t =>+  Functor (t IO) =>+  TMChan a ->+  t IO a+chanStream chan =+  takeUntilNothing (Stream.repeatM (liftIO (atomically (readTMChan chan))))++filesNative ::+  Members [Async, Embed IO] r =>+  FilesConfig ->+  NonEmpty (Path Abs Dir) ->+  Sem r (SerialT IO (MenuItem (Path Abs File)))+filesNative conf paths = do+  chan <- embed (atomically newTMChan)+  void . async $ runScanners conf chan (withBaseIndicators paths)+  pure (menuItem <$> chanStream chan)+  where+    menuItem (FileScanItem base baseIndicator path) =+      fileMenuItem base baseIndicator path++rgExcludes :: FilesConfig -> [Text]+rgExcludes (FilesConfig _ _ _ _ wilds) =+  concat (wild <$> wilds)+  where+    wild i =+      ["--glob", [exon|!#{i}|]]++findBase ::+  Path Abs File ->+  NonEmpty (Path Abs Dir, Maybe Text) ->+  Maybe (Path Abs Dir, Maybe Text)+findBase file =+  find ((`isProperPrefixOf` file) . fst)++rgMenuItem ::+  NonEmpty (Path Abs Dir, Maybe Text) ->+  Text ->+  Maybe (MenuItem (Path Abs File))+rgMenuItem bases file = do+  path <- parseAbsFile (toString file)+  (base, baseIndicator) <- findBase path bases+  pure (fileMenuItem base baseIndicator path)++filesRg ::+  Path Abs File ->+  FilesConfig ->+  NonEmpty (Path Abs Dir) ->+  SerialT IO (MenuItem (Path Abs File))+filesRg rgExe conf paths =+  Stream.mapMaybe item $+  processLines rgExe ("--files" : excludes <> patterns)+  where+    patterns =+      toText . toFilePath <$> toList paths+    excludes =+      rgExcludes conf+    item =+      rgMenuItem (withBaseIndicators paths)++files ::+  Members [Async, Embed IO] r =>+  FilesConfig ->+  NonEmpty (Path Abs Dir) ->+  Sem r (SerialT IO (MenuItem (Path Abs File)))+files conf@(FilesConfig useRg _ _ _ _) paths =+  filterM doesDirExist (toList paths) >>= \case+    [] ->+      pure Stream.nil+    p : ps ->+      findExecutable [relfile|rg|] >>= \case+        Just rgExe | useRg ->+          pure (filesRg rgExe conf (p :| ps))+        _ ->+          filesNative conf (p :| ps)
+ lib/Proteome/Files/Syntax.hs view
@@ -0,0 +1,54 @@+module Proteome.Files.Syntax where++import qualified Data.Map.Strict as Map (fromList)+import Ribosome.Data.SyntaxItem (SyntaxItem (options, params))+import Ribosome.Syntax (HiLink (HiLink), Syntax (Syntax), syntaxMatch, syntaxVerbatim)+import Text.RawString.QQ (r)++asterisk :: SyntaxItem+asterisk =+  item {options, params}+  where+    item = syntaxMatch "ProFilesAsterisk" [r|^ \*|]+    options = ["skipwhite"]+    params = Map.fromList [("nextgroup", "ProFilesBase,ProFilesName")]++base :: SyntaxItem+base =+  item {options, params}+  where+    item = syntaxMatch "ProFilesBase" [r|\[[^]]\+\]|]+    options = ["skipwhite", "contained"]+    params = Map.fromList [("nextgroup", "ProFilesName")]++name :: SyntaxItem+name =+  item {options}+  where+    item = syntaxMatch "ProFilesName" ".*"+    options = ["contained"]++sync :: SyntaxItem+sync =+  syntaxVerbatim "syntax sync minlines=1"++hlAsterisk :: HiLink+hlAsterisk =+  HiLink "ProFilesAsterisk" "Todo"++hlBase :: HiLink+hlBase =+  HiLink "ProFilesBase" "Directory"++hlName :: HiLink+hlName =+  HiLink "ProFilesName" "Type"++filesSyntax :: Syntax+filesSyntax =+  Syntax items [] links+  where+    items =+      [asterisk, base, name, sync]+    links =+      [hlAsterisk, hlBase, hlName]
+ lib/Proteome/Grep.hs view
@@ -0,0 +1,290 @@+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 (Eq, Show)++navigate ::+  Member Rpc r =>+  Path Abs File ->+  Int ->+  Maybe Int ->+  Sem r ()+navigate path line col = do+  edit path+  setCurrentCursor line (fromMaybe 0 col)+  nvimCommand "normal! zv"+  nvimCommand "normal! zz"++selectResult ::+  MenuWidget GrepState r GrepAction+selectResult = do+  withFocus \ (GrepOutputLine path line col _) ->+    pure (Select path line col)++yankResult ::+  Members [Rpc, Resource, Embed IO] r =>+  MenuWidget GrepState r GrepAction+yankResult =+  withFocus \ (GrepOutputLine _ _ _ txt) ->+    NoAction <$ setregLine (Register.Special "\"") [txt]++replaceResult ::+  MenuWidget GrepState r GrepAction+replaceResult =+  menuState $ withSelection (pure . Replace)++deleteResult ::+  MenuWidget GrepState r GrepAction+deleteResult =+  menuState $ withSelection (pure . Delete)++menuItemSameLine :: MenuItem GrepOutputLine -> MenuItem GrepOutputLine -> Bool+menuItemSameLine l r =+  GrepOutputLine.sameLine (l ^. #meta) (r ^. #meta)++uniqBy ::+  Functor (t IO) =>+  IsStream t =>+  (a -> a -> Bool) ->+  t IO a ->+  t IO a+uniqBy f =+  Stream.catMaybes .+  Stream.smapM (flip check) (pure Nothing)+  where+    check new =+      pure . \case+        Just old | f old new ->+          (Just old, Nothing)+        Just _ ->+          (Just new, Just new)+        Nothing ->+          (Just new, Just new)++uniqueGrepLines ::+  Functor (t IO) =>+  IsStream t =>+  t IO (MenuItem GrepOutputLine) ->+  t IO (MenuItem GrepOutputLine)+uniqueGrepLines =+  uniqBy 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 path patt opt = do+  cwd <- nvimCwd+  userCmd <- Settings.maybe Settings.grepCmdline+  grepper <- maybe defaultCmdline pure userCmd+  (exe, args) <- grepCmdline grepper patt path opt+  items <- grepMenuItems cwd exe args+  pure (uniqueGrepLines items)++actions ::+  Members [Scratch, Rpc, Rpc !! RpcError, AtomicState Env, Stop ReplaceError, Resource, Embed IO] r =>+  Mappings GrepState r GrepAction+actions =+  [+    ("<cr>", selectResult),+    ("y", yankResult),+    ("r", replaceResult),+    ("d", deleteResult)+  ]++grepAction ::+  Members [Scratch, Rpc, Rpc !! RpcError, AtomicState Env, Stop ReplaceError, Resource, Embed IO] r =>+  GrepAction ->+  Sem r ()+grepAction = \case+  Select path line col ->+    navigate path line col+  Replace results ->+    replaceBuffer results+  Delete results ->+     deleteLines (toList results)+  NoAction ->+    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 =+  mapReport @GrepError .+  mapReport @ReplaceError .+  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 opt path patt =+  mapReport @RpcError do+    items <- grepItems path patt opt+    result <- windowMenu items (modal Fuzzy) (def & #items .~ scratchOptions) actions+    handleResult grepAction result+  where+    scratchOptions =+      def {+        name = ScratchId name,+        syntax = [grepSyntax],+        filetype = Just name+      }+    name =+      "proteome-grep"++askUser ::+  Members [Rpc, Stop GrepError] r =>+  Text ->+  [Text] ->+  Sem r Text+askUser purpose args = do+  spec <- nvimCallFunction "input" (toMsgpack <$> [exon|#{purpose}: |] : args)+  if Text.null spec then stop (GrepError.EmptyUserInput purpose) else pure spec++grepWithNative ::+  Members GrepStack r =>+  [Text] ->+  Maybe Text ->+  Maybe Args ->+  Handler r ()+grepWithNative opt pathSpec pattSpec = do+  handleErrors do+    path <- nvimDir =<< maybe (askUser "directory" [".", "dir"]) pure pathSpec+    patt <- resumeReport @Rpc $ mapReport @GrepError do+      maybe (askUser "pattern" []) (pure . unArgs) pattSpec+    grepWith opt path patt++proGrepIn ::+  Members GrepStack r =>+  Maybe Text ->+  Maybe Args ->+  Handler r ()+proGrepIn =+  grepWithNative []++proGrepOpt ::+  Members GrepStack r =>+  Text ->+  Maybe Args ->+  Handler r ()+proGrepOpt opt patt = do+  cwd <- resumeReport @Rpc $ mapReport @GrepError do+    nvimCwd+  grepWithNative (Text.words opt) (Just (pathText cwd)) patt++proGrepOptIn ::+  Members GrepStack r =>+  Text ->+  Maybe Text ->+  Maybe Args ->+  Handler r ()+proGrepOptIn opt =+  grepWithNative (Text.words opt)++proGrep ::+  Members GrepStack r =>+  Maybe Args ->+  Handler r ()+proGrep =+  proGrepOpt ""++proGrepList ::+  Members GrepStack r =>+  Text ->+  Maybe Text ->+  Maybe Text ->+  Handler r [GrepOutputLine]+proGrepList patt pathSpec opt = do+  path <- resumeReport @Rpc (nvimDir (fromMaybe "." pathSpec))+  items <- handleErrors (grepItems path patt (Text.words (fold opt)))+  fmap (view #meta) <$> embed (Stream.toList items)
+ lib/Proteome/Grep/Parse.hs view
@@ -0,0 +1,56 @@+module Proteome.Grep.Parse where++import Chiasma.Data.Ident (generateIdent, identText)+import Data.Attoparsec.Text (parseOnly)+import qualified Data.Text as Text (strip)+import Exon (exon)+import qualified Log+import Path (Abs, Dir, Path, parseAbsFile, parseRelFile, stripProperPrefix, (</>))+import Ribosome (pathText)+import Ribosome.Menu.Data.MenuItem (MenuItem (MenuItem))+import Text.Parser.Char (anyChar, char, noneOf)+import Text.Parser.Combinators (manyTill)+import Text.Parser.Token (TokenParsing, natural)++import Proteome.Data.GrepOutputLine (GrepOutputLine (GrepOutputLine))+import Proteome.Grep.Syntax (lineNumber)++grepParser ::+  MonadFail m =>+  TokenParsing m =>+  Path Abs Dir ->+  m GrepOutputLine+grepParser cwd =+  GrepOutputLine <$> path <*> (subtract 1 <$> number) <*> optional number <*> (toText <$> many anyChar)+  where+    path = do+      s <- manyTill (noneOf ":") (char ':')+      maybe (fail "not a path") pure (parseAbsFile s <|> ((cwd </>) <$> parseRelFile s))+    number =+      (fromInteger <$> natural) <* char ':'++formatGrepLine :: Path Abs Dir -> GrepOutputLine -> Text+formatGrepLine cwd (GrepOutputLine path line col text) =+  [exon|#{relativePath} #{lineNumber} #{show line}:#{show (fromMaybe 1 col)} #{Text.strip text}|]+  where+    relativePath =+      maybe (pathText path) pathText (stripProperPrefix cwd path)++parseGrepOutput ::+  Members [Log, Embed IO] r =>+  Path Abs Dir ->+  Text ->+  Sem r (Maybe (MenuItem GrepOutputLine))+parseGrepOutput cwd =+  item . parseOnly (grepParser cwd)+  where+    item (Right a) = do+      ident <- identText <$> generateIdent+      pure (Just (convert ident a))+    item (Left err) =+      Nothing <$ Log.debug [exon|parsing grep output failed: #{toText err}|]+    convert _ file =+      MenuItem file text [exon| * #{text}|]+      where+        text =+          formatGrepLine cwd file
+ lib/Proteome/Grep/Process.hs view
@@ -0,0 +1,124 @@+module Proteome.Grep.Process where++import qualified Data.Text as Text+import Data.Text (isInfixOf)+import Path (Abs, Dir, File, Path, parseAbsFile, relfile, toFilePath)+import Path.IO (findExecutable, isLocationOccupied)+import Ribosome (pathText)+import Ribosome.Final (inFinal_)+import Ribosome.Menu (MenuItem)+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Unicode.Stream as Stream+import qualified Streamly.Prelude as Stream+import Streamly.Prelude (IsStream)+import qualified Streamly.System.Process as Process+import Streamly.System.Process (ProcessFailure)++import qualified Proteome.Data.GrepError as GrepError (GrepError (..))+import Proteome.Data.GrepError (GrepError)+import Proteome.Data.GrepOutputLine (GrepOutputLine)+import Proteome.Grep.Parse (parseGrepOutput)+import Proteome.System.Path (findExe)++defaultGrepCmdline :: Text+defaultGrepCmdline =+  "grep -Hnr {pattern} {path}"++defaultRgCmdline :: Text+defaultRgCmdline =+  "rg --vimgrep --no-heading -e {pattern} {path}"++defaultCmdline ::+  Member (Embed IO) r =>+  Sem r Text+defaultCmdline =+  findExecutable [relfile|rg|] <&> \case+    Just _ ->+      defaultRgCmdline+    _ ->+      defaultGrepCmdline++patternPlaceholder :: Text+patternPlaceholder =+  "{pattern}"++pathPlaceholder :: Text+pathPlaceholder =+  "{path}"++replaceOrAppend :: Text -> Text -> [Text] -> [Text]+replaceOrAppend placeholder target segments | any (placeholder `isInfixOf`) segments =+  Text.replace placeholder target <$> segments+replaceOrAppend _ target segments =+  segments <> [target]++parseAbsExe ::+  Member (Stop GrepError) r =>+  Text ->+  Sem r (Path Abs File)+parseAbsExe exe =+  stopEitherAs (GrepError.NoSuchExecutable exe) $ parseAbsFile (toString exe)++grepCmdline ::+  Members [Stop GrepError, Embed IO] r =>+  Text ->+  Text ->+  Path Abs Dir ->+  [Text] ->+  Sem r (Path Abs File, [Text])+grepCmdline cmdline patt destination opt = do+  when (Text.null exe) do+    stop GrepError.Empty+  absExe <- if absolute exe then parseAbsExe exe else findExe exe+  unlessM (isLocationOccupied destination) do+    stop destError+  pure (absExe, withDir destination)+  where+    absolute a =+      Text.take 1 a == "/"+    argSegments =+      opt <> Text.words (Text.strip args)+    (exe, args) =+      Text.breakOn " " (Text.strip cmdline)+    withDir dir =+      replaceOrAppend pathPlaceholder (pathText dir) withPattern+    withPattern =+      replaceOrAppend patternPlaceholder patt argSegments+    destError =+      GrepError.NoSuchDestination destination++processOutput ::+  IsStream t =>+  String ->+  [Text] ->+  t IO Word8+processOutput exe args =+  Process.toBytes exe (toString <$> args)++processLines ::+  IsStream t =>+  Path Abs File ->+  [Text] ->+  t IO Text+processLines exe args =+  Stream.lines (toText <$> Fold.toList) $+  Stream.decodeUtf8 $+  processOutput (toFilePath exe) args++grepMenuItems ::+  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 cwd exe args =+  inFinal_ \ lower _ pur ->+    pur $+    Stream.handle processFailure $+    Stream.mapMaybeM (fmap join . lower . parseGrepOutput cwd) $+    processLines exe args+  where+    processFailure (_ :: ProcessFailure) =+      Stream.nil
+ lib/Proteome/Grep/Replace.hs view
@@ -0,0 +1,175 @@+module Proteome.Grep.Replace where++import qualified Data.List.NonEmpty as NonEmpty (toList)+import qualified Data.Text as Text+import Path (parseAbsFile)+import Prelude hiding (group)+import Ribosome (+  Buffer,+  Handler,+  Rpc,+  RpcError,+  Scratch,+  ScratchId (ScratchId),+  ScratchState (ScratchState),+  mapReport,+  pathText,+  resumeReport,+  toMsgpack,+  )+import Ribosome.Api (bufferGetLines, bufferSetLines, bufferSetOption, nvimCommand, vimCallFunction)+import Ribosome.Api.Autocmd (bufferAutocmd)+import Ribosome.Api.Buffer (addBuffer, bufferContent, bufferForFile, wipeBuffer)+import Ribosome.Api.Option (withOption)+import Ribosome.Data.FileBuffer (FileBuffer (FileBuffer))+import qualified Ribosome.Data.FloatOptions as FloatBorder+import Ribosome.Data.FloatOptions (FloatOptions (FloatOptions))+import Ribosome.Host.Data.RpcType (group)+import qualified Ribosome.Scratch as Scratch++import qualified Proteome.Data.Env as Env (replace)+import Proteome.Data.Env (Env)+import qualified Proteome.Data.GrepOutputLine as GrepOutputLine+import Proteome.Data.GrepOutputLine (GrepOutputLine (GrepOutputLine))+import Proteome.Data.Replace (Replace (Replace))+import qualified Proteome.Data.ReplaceError as ReplaceError (ReplaceError (BadReplacement, CouldntLoadBuffer))+import Proteome.Data.ReplaceError (ReplaceError)++scratchName :: Text+scratchName =+  "proteome-replace"++replaceBuffer ::+  Members [Scratch, Rpc, AtomicState Env] r =>+  NonEmpty GrepOutputLine ->+  Sem r ()+replaceBuffer lines' = do+  scratch <- Scratch.show content options+  let buffer = Scratch.buffer scratch+  bufferSetOption buffer "buftype" ("acwrite" :: Text)+  bufferAutocmd buffer "BufWriteCmd" def { group = Just "ProteomeReplace" } "silent! ProReplaceSave"+  bufferAutocmd buffer "BufUnload" def { group = Just "ProteomeReplace" } "silent! ProReplaceQuit"+  atomicModify' (#replace ?~ Replace scratch lines')+  where+    content =+      GrepOutputLine.content <$> lines'+    options =+      def {+        Scratch.name = ScratchId scratchName,+        Scratch.modify = True,+        Scratch.focus = True,+        Scratch.filetype = Just scratchName+      }++-- If the deleted line was surrounded by blank lines or buffer edges, there will be extraneous whitespace.+-- First check whether the line number of the deleted line was line 0 and its content is now empty.+-- Then do the same for the last line.+-- Finally, check if both the preceding and current line are empty.+deleteExtraBlankLine ::+  Member Rpc r =>+  Buffer ->+  Int ->+  Sem r ()+deleteExtraBlankLine buffer line = do+  check (line - 2) line [""]+  check line (line + 1) [""]+  check (line - 1) line ["", ""]+  where+    check l r target = do+      content <- readLines l (r + 1)+      when (content == target) delete+    readLines l r =+      bufferGetLines buffer (clamp0 l) r False+    delete =+      bufferSetLines buffer line (line + 1) False []+    clamp0 a | a < 0 = 0+    clamp0 a = a++fileBuffer ::+  Member Rpc r =>+  Text ->+  Sem r (Maybe FileBuffer)+fileBuffer path =+  join <$> traverse bufferForFile (parseAbsFile (toString path))++replaceLine ::+  Members [Rpc, Stop ReplaceError] r =>+  Text ->+  GrepOutputLine ->+  Sem r (Maybe Buffer)+replaceLine updatedLine (GrepOutputLine path line _ _) = do+  exists <- isJust <$> bufferForFile path+  unless exists (addBuffer (pathText path))+  () <- vimCallFunction "bufload" [toMsgpack path]+  FileBuffer buffer _ <- stopNote (ReplaceError.CouldntLoadBuffer path) =<< bufferForFile path+  bufferSetLines buffer line (line + 1) False replacement+  deleteExtraBlankLine buffer line+  pure (bool (Just buffer) Nothing exists)+  where+    replacement =+      [updatedLine | not (Text.null updatedLine)]++lineNumberDesc :: (Text, GrepOutputLine) -> Int+lineNumberDesc (_, GrepOutputLine _ number _ _) =+  -number++replaceFloatOptions :: FloatOptions+replaceFloatOptions =+  FloatOptions def 1 1 0 0 False def Nothing FloatBorder.None True False (Just def) (Just 1)++withReplaceEnv ::+  Members [Rpc !! RpcError, Rpc, Resource] r =>+  Sem r [Maybe Buffer] ->+  Sem r ()+withReplaceEnv run = do+  withOption "hidden" True do+    transient <- run+    resume_ (nvimCommand "noautocmd wall")+    traverse_ wipeBuffer (catMaybes transient)++replaceLines ::+  Members [Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>+  Buffer ->+  [(Text, GrepOutputLine)] ->+  Sem r ()+replaceLines scratchBuffer lines' = do+  bufferSetOption scratchBuffer "buftype" ("nofile" :: Text)+  withReplaceEnv do+    traverse (uncurry replaceLine) (sortOn lineNumberDesc lines')+  bufferSetOption scratchBuffer "buftype" ("acwrite" :: Text)+  bufferSetOption scratchBuffer "modified" False++deleteLines ::+  Members [Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>+  [GrepOutputLine] ->+  Sem r ()+deleteLines lines' =+  withReplaceEnv do+    traverse (uncurry replaceLine) (sortOn lineNumberDesc (zip (repeat "") lines'))++replaceSave ::+  Members [Rpc !! RpcError, Rpc, Resource, Stop ReplaceError] r =>+  Replace ->+  Sem r ()+replaceSave (Replace (ScratchState _ _ buffer _ _ _ _) lines') = do+  updatedLines <- bufferContent buffer+  if length updatedLines /= length lines'+  then badReplacement+  else replaceLines buffer (zip updatedLines (NonEmpty.toList lines'))+  where+    badReplacement =+      stop ReplaceError.BadReplacement++-- TODO quit after saving, controlled by setting+proReplaceSave ::+  Members [AtomicState Env, Rpc !! RpcError, Resource] r =>+  Handler r ()+proReplaceSave =+  resumeReport $ mapReport do+    traverse_ replaceSave =<< atomicGets Env.replace++proReplaceQuit ::+  Member (AtomicState Env) r =>+  Handler r ()+proReplaceQuit =+  atomicModify' (#replace .~ Nothing)
+ lib/Proteome/Grep/Syntax.hs view
@@ -0,0 +1,103 @@+module Proteome.Grep.Syntax where++import qualified Data.Map.Strict as Map (fromList)+import Ribosome.Data.Syntax.Syntax (HiLink (HiLink), Syntax (Syntax))+import Ribosome.Data.SyntaxItem (SyntaxItem (options, params))+import Ribosome.Syntax (syntaxMatch, syntaxVerbatim)+import Text.RawString.QQ (r)++lineNumber :: Text+lineNumber =+  "\57505"++asterisk :: SyntaxItem+asterisk =+  item {options, params}+  where+    item = syntaxMatch "ProGrepAsterisk" [r|^ \*|]+    options = ["skipwhite"]+    params = Map.fromList [("nextgroup", "ProGrepPath")]++path :: SyntaxItem+path =+  item {options, params}+  where+    item = syntaxMatch "ProGrepPath" ([r|.*\ze|] <> lineNumber)+    options = ["contained", "skipwhite"]+    params = Map.fromList [("nextgroup", "ProGrepLN")]++ln :: SyntaxItem+ln =+  item {options, params}+  where+    item = syntaxMatch "ProGrepLN" lineNumber+    options = ["contained", "skipwhite"]+    params = Map.fromList [("nextgroup", "ProGrepLine")]++line :: SyntaxItem+line =+  item {options, params}+  where+    item = syntaxMatch "ProGrepLine" [r|\d\+\ze:|]+    options = ["contained"]+    params = Map.fromList [("nextgroup", "ProGrepColon")]++colon :: SyntaxItem+colon =+  item {options, params}+  where+    item = syntaxMatch "ProGrepColon" [r|:|]+    options = ["contained"]+    params = Map.fromList [("nextgroup", "ProGrepCol")]++col :: SyntaxItem+col =+  item {options, params}+  where+    item = syntaxMatch "ProGrepCol" [r|\d\+|]+    options = ["contained", "skipwhite"]+    params = Map.fromList [("nextgroup", "ProGrepText")]++text_ :: SyntaxItem+text_ =+  item { options }+  where+    item = syntaxMatch "ProGrepText" [r|.\+|]+    options = ["contained"]++sync :: SyntaxItem+sync =+  syntaxVerbatim "syntax sync minlines=1"++hlAsterisk :: HiLink+hlAsterisk =+  HiLink "ProGrepAsterisk" "Todo"++hlPath :: HiLink+hlPath =+  HiLink "ProGrepPath" "Type"++hlLn :: HiLink+hlLn =+  HiLink "ProGrepLN" "LineNr"++hlLine :: HiLink+hlLine =+  HiLink "ProGrepLine" "Constant"++hlCol :: HiLink+hlCol =+  HiLink "ProGrepCol" "Constant"++hlText :: HiLink+hlText =+  HiLink "ProGrepText" "Directory"++grepSyntax :: Syntax+grepSyntax =+  Syntax items [] links+  where+    items =+      [asterisk, path, ln, line, col, colon, text_, sync]+    links =+      [hlAsterisk, hlPath, hlLn, hlLine, hlCol, hlText]
lib/Proteome/Init.hs view
@@ -1,105 +1,96 @@-module Proteome.Init(-  initialize,-  proteomeStage2,-  proteomeStage4,-  proteomePoll,-  proteomeStage1,-  resolveMainProject,-  initWithMain,-  resolveAndInitMain,-) where+module Proteome.Init where -import Data.Default.Class (Default(def))-import qualified Control.Lens as Lens (set)-import Data.Maybe (fromMaybe)-import Data.Either (fromRight)-import System.Log.Logger (updateGlobalLogger, setLevel, Priority(ERROR))-import Control.Monad.IO.Class (liftIO)-import UnliftIO.Directory (getCurrentDirectory)-import UnliftIO.STM (TVar)-import Neovim (Neovim, vim_call_function', fromObject)-import Neovim.Context.Internal (Config(customConfig), asks')-import Ribosome.Config.Setting (settingE, updateSetting)-import Ribosome.Control.Ribo (Ribo)-import qualified Ribosome.Control.Ribo as Ribo (inspect, modify)-import Ribosome.Control.Ribosome (newRibosome, Ribosome)-import Ribosome.Internal.IO (retypeNeovim)-import qualified Proteome.Data.Env as Env (mainProject, _mainProject)+import Exon (exon)+import qualified Log+import Ribosome (Handler, Rpc, RpcError, SettingError, Settings, resumeReport)+import Ribosome.Api (nvimCallFunction, uautocmd)+import qualified Ribosome.Settings as Settings++import Proteome.Config (logConfig, readConfig) import Proteome.Data.Env (Env)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  Project(meta),-  ProjectType(..),-  ProjectMetadata(DirProject, VirtualProject),-  )-import Proteome.Project (pathData)-import Proteome.Project.Resolve (resolveProjectFromConfig)+import qualified Proteome.Data.Env as Env (mainProject)+import Proteome.Data.Project (Project (Project))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))+import Proteome.Data.ProjectType (ProjectType (ProjectType))+import Proteome.Data.ResolveError (ResolveError) import Proteome.Project.Activate (activateProject)-import Proteome.Config (readConfig, logConfig)-import Proteome.PersistBuffers (loadBuffers)-import qualified Proteome.Log as Log-import qualified Proteome.Settings as S+import Proteome.Project.Resolve (fromRootSettings)+import qualified Proteome.Settings as Settings (mainName, mainProjectDir, mainType) -resolveMainProject :: Ribo e Project+resolveMainProject ::+  Members [Settings, Settings !! SettingError, Rpc, Stop ResolveError, Embed IO] r =>+  Sem r Project resolveMainProject = do-  mainDir <- settingE S.mainProjectDir-  vimCwd <- vim_call_function' "getcwd" []-  cwd <- getCurrentDirectory-  (root, name, tpe) <- pathData (fromRight (fromRight cwd (fromObject vimCwd)) mainDir)-  resolveProjectFromConfig (Just root) name (Just tpe)--setMainProject :: Project -> Proteome ()-setMainProject project =-  Ribo.modify $ Lens.set Env._mainProject project+  mainDir <- Settings.maybe Settings.mainProjectDir+  vimCwd <- nvimCallFunction "getcwd" []+  fromRootSettings (ProjectRoot (fromMaybe vimCwd mainDir)) -updateMainType :: Maybe ProjectType -> Proteome ()-updateMainType tpe = updateSetting S.mainType (fromMaybe (ProjectType "none") tpe)+updateMainType ::+  Member Settings r =>+  Maybe ProjectType ->+  Sem r ()+updateMainType tpe =+  Settings.update Settings.mainType (fromMaybe (ProjectType "none") tpe) -setMainProjectVars :: ProjectMetadata -> Proteome ()-setMainProjectVars (DirProject name _ tpe) = do-  updateSetting S.mainName name-  updateMainType tpe-setMainProjectVars (VirtualProject name) = do-  updateSetting S.mainName name-  updateMainType (Just (ProjectType "virtual"))+setMainProjectVars ::+  Member Settings r =>+  ProjectMetadata ->+  Sem r ()+setMainProjectVars = \case+  DirProject name _ tpe -> do+    Settings.update Settings.mainName name+    updateMainType tpe+  VirtualProject name -> do+    Settings.update Settings.mainName name+    updateMainType (Just (ProjectType "virtual")) -initWithMain :: Project -> Proteome ()-initWithMain main = do-  Log.debugS $ "initializing with main project: " ++ show main-  setMainProject main-  setMainProjectVars (meta main)+initWithMain ::+  Members [AtomicState Env, Settings, Rpc, Log, Embed IO] r =>+  Project ->+  Sem r ()+initWithMain main@(Project meta _ _ _) = do+  Log.debug [exon|initializing with main project: #{show main}|]+  atomicModify' (#mainProject .~ main)+  setMainProjectVars meta   activateProject main -resolveAndInitMain :: Proteome ()-resolveAndInitMain = do-  main <- resolveMainProject-  initWithMain main--initialize' :: Proteome (Ribosome (TVar Env))-initialize' = do-  resolveAndInitMain-  asks' customConfig+resolveAndInitMain ::+  Members [AtomicState Env, Settings !! SettingError, Settings, Rpc, Stop ResolveError, Log, Embed IO] r =>+  Sem r ()+resolveAndInitMain =+  initWithMain =<< resolveMainProject -initialize :: Neovim e (Ribosome (TVar Env))-initialize = do-  liftIO $ updateGlobalLogger "Neovim.Plugin" (setLevel ERROR)-  ribo <- newRibosome "proteome" def-  retypeNeovim (const ribo) initialize'+loadConfig ::+  Members [AtomicState Env, Rpc] r =>+  Text ->+  Sem r ()+loadConfig dir =+  logConfig =<< readConfig dir =<< atomicGets Env.mainProject -proteomeStage1 :: Proteome ()-proteomeStage1 = loadBuffers+projectConfig ::+  Members [AtomicState Env, Rpc] r =>+  Sem r ()+projectConfig = do+  loadConfig "project"+  uautocmd "ProteomeProject" -proteomeStage2 :: Proteome ()-proteomeStage2 = do-  main <- Ribo.inspect Env.mainProject-  paths <- readConfig "project" main-  logConfig paths+projectConfigAfter ::+  Members [AtomicState Env, Rpc] r =>+  Sem r ()+projectConfigAfter = do+  loadConfig "project_after"+  uautocmd "ProteomeProjectAfter"+  uautocmd "RibosomeUpdateVariables" -proteomeStage4 :: Proteome ()-proteomeStage4 = do-  main <- Ribo.inspect Env.mainProject-  paths <- readConfig "project_after" main-  logConfig paths+proLoad ::+  Members [AtomicState Env, Rpc !! RpcError] r =>+  Handler r ()+proLoad =+  resumeReport @Rpc projectConfig -proteomePoll :: Neovim e Bool-proteomePoll = return True+proLoadAfter ::+  Members [AtomicState Env, Rpc !! RpcError] r =>+  Handler r ()+proLoadAfter =+  resumeReport @Rpc projectConfigAfter
− lib/Proteome/Log.hs 
@@ -1,22 +0,0 @@-module Proteome.Log(-  debug,-  info,-  debugS,-  infoS,-  R.p,-) where--import Ribosome.Control.Ribo (Ribo)-import qualified Ribosome.Log as R (debug, info, p)--debug :: String -> Ribo e ()-debug = R.debug "proteome"--info :: String -> Ribo e ()-info = R.info "proteome"--debugS :: Show a => a -> Ribo e ()-debugS = R.debug "proteome"--infoS :: Show a => a -> Ribo e ()-infoS = R.info "proteome"
+ lib/Proteome/Menu.hs view
@@ -0,0 +1,17 @@+module Proteome.Menu where++import Ribosome (Report, Rpc)+import Ribosome.Menu (MenuResult (Aborted, Error, Success))++handleResult ::+  Members [Rpc, Stop Report] r =>+  (a -> Sem r ()) ->+  MenuResult a ->+  Sem r ()+handleResult handle = \case+  Success a ->+    handle a+  Aborted ->+    unit+  Error e ->+    stop (fromText e)
+ lib/Proteome/Path.hs view
@@ -0,0 +1,103 @@+module Proteome.Path where++import qualified Data.Text as Text+import Path (+  Abs,+  Dir,+  File,+  Path,+  Rel,+  parent,+  parseAbsDir,+  parseAbsFile,+  parseRelDir,+  parseRelFile,+  (</>),+  )+import Path.IO (doesFileExist)+import Ribosome (pathText)++parsePathMaybe ::+  (FilePath -> Either a (Path b t)) ->+  Text ->+  Maybe (Path b t)+parsePathMaybe parser =+  rightToMaybe . parser . toString++parseAbsDirMaybe ::+  Text ->+  Maybe (Path Abs Dir)+parseAbsDirMaybe =+  parsePathMaybe parseAbsDir++parseAbsFileMaybe ::+  Text ->+  Maybe (Path Abs File)+parseAbsFileMaybe =+  parsePathMaybe parseAbsFile++parseRelDirMaybe ::+  Text ->+  Maybe (Path Rel Dir)+parseRelDirMaybe =+  parsePathMaybe parseRelDir++parseRelFileMaybe ::+  Text ->+  Maybe (Path Rel File)+parseRelFileMaybe =+  parsePathMaybe parseRelFile++absoluteParseDir ::+  Path Abs Dir ->+  Text ->+  Maybe (Path Abs Dir)+absoluteParseDir cwd spec =+  tryAbsolute <|> tryRelative+  where+    specS =+      toString spec+    tryAbsolute =+      rightToMaybe (parseAbsDir specS)+    tryRelative =+      makeAbsolute <$> rightToMaybe (parseRelDir specS)+    makeAbsolute path =+      cwd </> path++absoluteParse ::+  Path Abs Dir ->+  Text ->+  Maybe (Path Abs File)+absoluteParse cwd spec =+  tryAbsolute <|> tryRelative+  where+    specS =+      toString spec+    tryAbsolute =+      rightToMaybe (parseAbsFile specS)+    tryRelative =+      makeAbsolute <$> rightToMaybe (parseRelFile specS)+    makeAbsolute path =+      cwd </> path++existingFile ::+  MonadIO m =>+  Path Abs Dir ->+  Text ->+  m (Maybe (Path Abs File))+existingFile cwd spec =+  join <$> traverse check (absoluteParse cwd spec)+  where+    check path = do+      exists <- doesFileExist path+      pure $ if exists then Just path else Nothing++dropSlash :: Path b t -> Text+dropSlash =+  Text.dropWhileEnd ('/' ==) . pathText++rootPathSegment :: Path b Dir -> Path b Dir+rootPathSegment p =+  if parent (parent p) == parent p+  then p+  else rootPathSegment (parent p)
lib/Proteome/PersistBuffers.hs view
@@ -1,90 +1,87 @@-{-# LANGUAGE DeriveGeneric #-}--module Proteome.PersistBuffers(-  loadBuffers,-  storeBuffers,-  PersistBuffers(PersistBuffers),-) where--import GHC.Generics-import Control.Monad (filterM, when)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Except (runExceptT)-import Data.Aeson (ToJSON(toEncoding), FromJSON, genericToEncoding, defaultOptions)-import Data.Foldable (traverse_)-import System.Directory (doesFileExist)-import System.FilePath ((</>))-import Neovim (vim_get_current_buffer', vim_get_buffers', buffer_get_name', vim_command')-import Ribosome.Api.Buffer (edit, buflisted)-import Ribosome.Persist (persistStore, persistLoad)-import Ribosome.Control.Ribo (lockOrSkip)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  Project(Project),-  ProjectMetadata(DirProject),-  ProjectName(ProjectName),-  ProjectType(ProjectType)-  )-import Proteome.Env (getMainProject)--data PersistBuffers =-  PersistBuffers {-    current :: Maybe FilePath,-    buffers :: [FilePath]-  }-  deriving (Eq, Generic, Show)--instance ToJSON PersistBuffers where-  toEncoding = genericToEncoding defaultOptions+module Proteome.PersistBuffers where -instance FromJSON PersistBuffers+import Conc (Lock, lockOrSkip_)+import qualified Data.Text as Text (null)+import Exon (exon)+import qualified Log+import Path (Abs, Dir, File, Path, Rel, parseRelDir, relfile, toFilePath, (</>))+import Ribosome (Rpc, RpcError)+import Ribosome.Api (bufferGetName, vimCommand, vimGetCurrentBuffer)+import Ribosome.Api.Buffer (bufferForFile, buflisted, edit)+import qualified Ribosome.Data.FileBuffer as FileBuffer+import Ribosome.Effect.Persist (Persist)+import qualified Ribosome.Persist as Persist -projectSubPath :: Proteome (Maybe FilePath)-projectSubPath = do-  main <- getMainProject-  return $ case main of-    Project (DirProject (ProjectName name) _ (Just (ProjectType tpe))) _ _ _ -> Just $ tpe </> name-    _ -> Nothing+import Proteome.Data.Env (Env)+import qualified Proteome.Data.Env as Env (buffers, mainProject)+import Proteome.Data.PersistBuffers (PersistBuffers (PersistBuffers))+import Proteome.Data.Project (Project (Project))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))+import Proteome.Data.ProjectType (ProjectType (ProjectType))+import Proteome.Path (existingFile) -unsafeStoreBuffers :: FilePath -> Proteome ()-unsafeStoreBuffers path = do-  active <- vim_get_current_buffer'-  activeName <- buffer_get_name' active-  activeIsFile <- liftIO $ doesFileExist activeName-  let current' = if activeIsFile then Just activeName else Nothing-  all' <- vim_get_buffers' >>= filterM buflisted >>= traverse buffer_get_name'-  files <- liftIO $ filterM doesFileExist all'-  persistStore (path </> "buffers") (PersistBuffers current' files)+data StoreBuffersLock =+  StoreBuffersLock+  deriving stock (Eq, Show) -safeStoreBuffers :: FilePath -> Proteome ()-safeStoreBuffers path =-  lockOrSkip "store-buffers" $ unsafeStoreBuffers path+data LoadBuffersLock =+  LoadBuffersLock+  deriving stock (Eq, Show) -decodePersistBuffers :: FilePath -> Proteome (Either String PersistBuffers)-decodePersistBuffers path = runExceptT $ persistLoad (path </> "buffers")+file :: Path Rel File+file =+  [relfile|buffers.json|] -restoreBuffers :: PersistBuffers -> Proteome ()-restoreBuffers (PersistBuffers current' buffers') = do-  active <- vim_get_current_buffer'-  name <- buffer_get_name' active-  when (null name) $ mapM_ edit current'-  traverse_ (\a -> vim_command' ("silent! badd " ++ a)) buffers'+projectPaths ::+  Member (AtomicState Env) r =>+  Sem r (Maybe (Path Abs Dir, Path Rel Dir))+projectPaths =+  examine <$> atomicGets Env.mainProject+  where+    examine (Project (DirProject (ProjectName name) (ProjectRoot root) (Just (ProjectType tpe))) _ _ _) =+      (root,) <$> ((</>) <$> parseRelDir (toString tpe) <*> parseRelDir (toString name))+    examine _ =+      Nothing -unsafeLoadBuffers :: FilePath -> Proteome ()-unsafeLoadBuffers path = do-  pb <- decodePersistBuffers path-  mapM_ restoreBuffers pb+storeBuffers ::+  Member (Persist PersistBuffers) r =>+  Members [Lock @@ StoreBuffersLock, AtomicState Env, Rpc, Rpc !! RpcError, Resource, Embed IO] r =>+  Sem r ()+storeBuffers =+  tag $ lockOrSkip_ $ projectPaths >>= traverse_ \ (cwd, path) -> do+    names <- traverse bufferGetName =<< filterM buflisted =<< atomicGets Env.buffers+    files <- catMaybes <$> traverse (existingFile cwd) names+    Persist.store (Just (path </> file)) (PersistBuffers (listToMaybe files) files) -safeLoadBuffers :: FilePath -> Proteome ()-safeLoadBuffers path =-  lockOrSkip "load-buffers" $ unsafeLoadBuffers path+decodePersistBuffers ::+  Member (Persist PersistBuffers) r =>+  Path Rel Dir ->+  Sem r (Maybe PersistBuffers)+decodePersistBuffers path =+  Persist.load (Just (path </> file)) -storeBuffers :: Proteome ()-storeBuffers = do-  sub <- projectSubPath-  mapM_ safeStoreBuffers sub+restoreBuffers ::+  Members [Rpc, AtomicState Env, Log] r =>+  PersistBuffers ->+  Sem r ()+restoreBuffers (PersistBuffers active rest) = do+  Log.debug [exon|Restoring buffers. Active: #{show active}|]+  traverse_ loadActive active+  traverse_ add rest+  buffers <- traverse bufferForFile rest+  atomicModify' (#buffers .~ (FileBuffer.buffer <$> catMaybes buffers))+  where+    add a =+      vimCommand ("silent! badd " <> toText (toFilePath a))+    loadActive path = do+      currentBufferName <- bufferGetName =<< vimGetCurrentBuffer+      when (Text.null currentBufferName) (edit path) -loadBuffers :: Proteome ()-loadBuffers = do-  sub <- projectSubPath-  mapM_ safeLoadBuffers sub+loadBuffers ::+  Members [Persist PersistBuffers, Lock @@ LoadBuffersLock, Rpc, AtomicState Env, Log, Resource] r =>+  Sem r ()+loadBuffers =+  tag $ lockOrSkip_ $ projectPaths >>= traverse_ \ (_, path) ->+    traverse_ restoreBuffers =<< decodePersistBuffers path
lib/Proteome/Plugin.hs view
@@ -1,61 +1,194 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}--module Proteome.Plugin(-  plugin,-)-where+module Proteome.Plugin where -import Data.Default.Class (Default(def))-import UnliftIO.STM (TVar)-import Neovim (-  Plugin(..),-  function,-  function',-  command,-  command',-  autocmd,-  Neovim,-  StartupConfig,-  NeovimConfig,-  NeovimPlugin,-  Synchronous(..),-  wrapPlugin,-  CommandOption(CmdBang),+import Conc (ConcStack, Lock, Restoration, interpretAtomic, interpretLockReentrant, withAsync_)+import Polysemy.Chronos (ChronosTime)+import Ribosome (+  BootError,+  Event,+  Execution (Async, Sync),+  Persist,+  PersistError,+  PluginName,+  Reports,+  Rpc,+  RpcError,+  RpcHandler,+  Scratch,+  SettingError,+  Settings,+  completeBuiltin,+  interpretPersist,+  interpretPersistPath,+  logReport,+  resumeLogReport,+  rpc,+  rpcAutocmd,+  rpcCommand,+  rpcFunction,+  runNvimPluginIO,   )-import Ribosome.Control.Ribosome (Ribosome)-import Proteome.Init (proteomePoll, proteomeStage1, proteomeStage2, proteomeStage4, initialize)-import Proteome.Data.Env (Env)-import Proteome.Add (proAdd, proAddCmd)+import Ribosome.Data.PersistPathError (PersistPathError)+import Ribosome.Effect.PersistPath (PersistPath)+import Ribosome.Host.Data.Report (LogReport)+import Ribosome.Menu (ModalWindowMenus, NvimMenus, WindowMenus, interpretMenus, interpretWindowMenu)++import Proteome.Add (proAdd, proAddCmd, proAddMenu)+import Proteome.BufEnter (Mru, bufEnter)+import Proteome.Buffers (proBuffers) import Proteome.Config (proReadConfig)-import Proteome.Tags (proTags)-import Proteome.Save (proSave)-import Proteome.BufEnter (bufEnter)-import Proteome.Project.Activate (proNext, proPrev)+import Proteome.Data.AddItem (AddItem)+import Proteome.Data.CurrentTag (CurrentTag)+import Proteome.Data.Env (Env)+import Proteome.Data.FilesState (FilesState)+import Proteome.Data.GrepOutputLine (GrepOutputLine)+import Proteome.Data.ListedBuffer (ListedBuffer)+import Proteome.Data.PersistBuffers (PersistBuffers)+import Proteome.Data.ResolveError (ResolveError) import Proteome.Diag (proDiag)+import Proteome.Filename (proCopy, proMove, proRemove)+import Proteome.Files (proFiles)+import Proteome.Grep (proGrep, proGrepIn, proGrepList, proGrepOpt, proGrepOptIn)+import Proteome.Grep.Replace (proReplaceQuit, proReplaceSave)+import Proteome.Init (proLoad, proLoadAfter, projectConfig, projectConfigAfter, resolveAndInitMain)+import Proteome.PersistBuffers (LoadBuffersLock, StoreBuffersLock, loadBuffers)+import Proteome.Project.Activate (proNext, proPrev)+import Proteome.Quit (proQuit)+import Proteome.Save (proSave)+import Proteome.Tags.Cycle (proNextTag)+import Proteome.Tags.Gen (TagsLock, proGenTags)+import Proteome.Tags.Menu (proTag, proTags)+import Proteome.Tags.State (TagsState) -plugin' :: Ribosome (TVar Env) -> Plugin (Ribosome (TVar Env))-plugin' env =-  Plugin {-    environment = env,-    exports = [-      $(function' 'proteomePoll) Sync,-      $(function' 'proteomeStage1) Async,-      $(function' 'proteomeStage2) Async,-      $(function' 'proteomeStage4) Async,-      $(function "ProAddProject" 'proAdd) Sync,-      $(command "ProAdd" 'proAddCmd) [CmdBang],-      $(function' 'proSave) Async,-      $(function' 'proTags) Async,-      $(command' 'proNext) [],-      $(command' 'proPrev) [],-      $(function' 'proReadConfig) Sync,-      $(command' 'proDiag) [],-      $(autocmd 'bufEnter) "BufEnter" def-    ]-  }+type ProteomeStack =+  [+    AtomicState Env,+    AtomicState (Maybe CurrentTag),+    Lock @@ LoadBuffersLock,+    Lock @@ StoreBuffersLock,+    Lock @@ TagsLock,+    Lock @@ Mru+  ] -plugin :: Neovim (StartupConfig NeovimConfig) NeovimPlugin-plugin = do-  env <- initialize-  wrapPlugin $ plugin' env+type ProteomeProdStack =+  [+    Persist PersistBuffers !! PersistError,+    PersistPath !! PersistPathError,+    ModalWindowMenus () AddItem !! RpcError,+    ModalWindowMenus () ListedBuffer !! RpcError,+    ModalWindowMenus () GrepOutputLine !! RpcError,+    WindowMenus () FilesState !! RpcError,+    WindowMenus () TagsState !! RpcError+  ] ++ NvimMenus ++ ProteomeStack++handlers ::+  Members ProteomeProdStack r =>+  Members [Settings !! SettingError, Scratch !! RpcError, Rpc !! RpcError, Reports, Reader PluginName] r =>+  Members ConcStack r =>+  Members [DataLog LogReport, ChronosTime, Log, Mask Restoration, Race, Resource, Async, Embed IO, Final IO] r =>+  [RpcHandler r]+handlers =+  rpc "ProDiag" Async proDiag+  <>+  rpc "ProSave" Async proSave+  <>+  rpc "ProGenTags" Async proGenTags+  <>+  rpc "ProTags" Async proTags+  <>+  rpc "ProTag" Async proTag+  <>+  rpc "ProNextTag" Async proNextTag+  <>+  rpc "ProGrep" Async proGrep+  <>+  rpc "ProGrepIn" Async proGrepIn+  <>+  rpc "ProGrepOpt" Async proGrepOpt+  <>+  rpc "ProGrepOptIn" Async proGrepOptIn+  <>+  rpc "ProReplaceSave" Async proReplaceSave+  <>+  rpc "ProReplaceQuit" Async proReplaceQuit+  <>+  rpc "ProBuffers" Async proBuffers+  <>+  rpc "ProFiles" Async proFiles+  <>+  rpc "ProPrev" Async proPrev+  <>+  rpc "ProNext" Async proNext+  <>+  rpc "ProReadConfig" Async proReadConfig+  <>+  rpc "ProLoad" Async proLoad+  <>+  rpc "ProLoadAfter" Async proLoadAfter+  <>+  [+    rpcFunction "ProGrepList" Sync proGrepList,+    rpcFunction "ProAdd" Async proAdd,+    rpcCommand "ProAdd" Async proAddCmd,+    rpcCommand "ProAddMenu" Async proAddMenu,+    completeBuiltin "file" (rpcCommand "ProMove" Async proMove),+    completeBuiltin "file" (rpcCommand "ProCopy" Async proCopy),+    rpcCommand "ProRemove" Async proRemove,+    rpcAutocmd "BufEnter" Async "BufEnter" def bufEnter,+    rpcAutocmd "ProSave" Async "BufWritePost" def proSave,+    -- If this is Async, Neovim quits before the handler has run+    rpcAutocmd "ProQuit" Sync "VimLeave" def proQuit+  ]++resolveError ::+  Member (DataLog LogReport) r =>+  Sem (Stop ResolveError : r) () ->+  Sem r ()+resolveError sem =+  runStop sem >>= \case+    Left e ->+      logReport e+    Right () ->+      unit++prepare ::+  Members [Persist PersistBuffers !! PersistError, Log, Resource, Embed IO] r =>+  Members [AtomicState Env, Settings !! SettingError, Rpc !! RpcError, Lock @@ LoadBuffersLock, DataLog LogReport] r =>+  Sem r ()+prepare = do+  resolveError $ resumeLogReport @Settings $ resumeLogReport @Rpc do+    resolveAndInitMain+  resumeLogReport @(Persist _) (resumeLogReport @Rpc loadBuffers)+  resumeLogReport @Rpc projectConfig+  resumeLogReport @Rpc projectConfigAfter++interpretProteomeStack ::+  Members [Race, Resource, Mask Restoration, Embed IO] r =>+  InterpretersFor ProteomeStack r+interpretProteomeStack =+  interpretLockReentrant . untag .+  interpretLockReentrant . untag .+  interpretLockReentrant . untag .+  interpretLockReentrant . untag .+  interpretAtomic def .+  interpretAtomic def++interpretProteomeProdStack ::+  Member (EventConsumer eres Event) r =>+  Members [Rpc !! RpcError, Settings !! SettingError, Scratch !! RpcError, Reader PluginName, DataLog LogReport] r =>+  Members [Error BootError, Race, Log, Resource, Mask Restoration, Async, Embed IO, Final IO] r =>+  InterpretersFor ProteomeProdStack r+interpretProteomeProdStack =+  interpretProteomeStack .+  interpretWindowMenu .+  interpretMenus .+  interpretMenus .+  interpretMenus .+  interpretMenus .+  interpretMenus .+  interpretPersistPath True .+  interpretPersist "buffers" .+  withAsync_ prepare++proteome :: IO ()+proteome =+  runNvimPluginIO @ProteomeProdStack "proteome" interpretProteomeProdStack handlers
lib/Proteome/Project.hs view
@@ -1,40 +1,35 @@-module Proteome.Project(-  allProjects,-  currentProject,-  pathData,-) where+module Proteome.Project where -import Control.Monad.IO.Class (MonadIO, liftIO)-import Safe (atMay)-import System.Directory (makeAbsolute)-import System.FilePath (takeFileName, takeDirectory)-import qualified Ribosome.Control.Ribo as Ribo (inspect)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  Project,-  ProjectName(..),-  ProjectRoot(..),-  ProjectType(..),-  )-import Proteome.Data.Env (Env(mainProject, projects, currentProjectIndex))+import qualified Control.Lens as Lens (element, firstOf)+import Path (Abs, Dir, Path, dirname, parent) -allProjects :: Proteome [Project]+import Proteome.Data.Env (Env)+import qualified Proteome.Data.Env as Env (currentProjectIndex, mainProject, projects)+import Proteome.Data.Project (Project)+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))+import Proteome.Data.ProjectType (ProjectType (ProjectType))+import Proteome.Path (dropSlash)++allProjects ::+  Member (AtomicState Env) r =>+  Sem r [Project] allProjects = do-  main <- Ribo.inspect mainProject-  extra <- Ribo.inspect projects-  return $ main : extra+  main <- atomicGets Env.mainProject+  extra <- atomicGets Env.projects+  pure $ main : extra -currentProject :: Proteome (Maybe Project)+currentProject ::+  Member (AtomicState Env) r =>+  Sem r (Maybe Project) currentProject = do-  index <- Ribo.inspect currentProjectIndex-  pros <- allProjects-  return $ atMay pros index+  index <- atomicGets Env.currentProjectIndex+  Lens.firstOf (Lens.element index) <$> allProjects -pathData :: MonadIO m => FilePath -> m (ProjectRoot, ProjectName, ProjectType)-pathData root = do-  absMainDir <- liftIO $ makeAbsolute root-  return (-    ProjectRoot absMainDir,-    ProjectName $ takeFileName absMainDir,-    ProjectType $ (takeFileName . takeDirectory) absMainDir-    )+pathData :: Path Abs Dir -> (ProjectRoot, ProjectName, ProjectType)+pathData root =+  (+    ProjectRoot root,+    ProjectName . dropSlash . dirname $ root,+    ProjectType . dropSlash . dirname . parent $ root+  )
lib/Proteome/Project/Activate.hs view
@@ -1,85 +1,101 @@-module Proteome.Project.Activate(-  activateProject,-  activateCurrentProject,-  proPrev,-  proNext,-  selectProject,-) where+module Proteome.Project.Activate where -import qualified Control.Lens as Lens (over, set)-import Control.Monad (when)-import Control.Monad.IO.Class (liftIO)-import Data.Maybe (fromMaybe)-import System.Directory (doesDirectoryExist)-import Neovim (vim_command', CommandArguments, Neovim)-import Ribosome.Config.Setting (updateSetting)-import Ribosome.Control.Ribo (Ribo)-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Proteome.Data.Project (-  Project(Project, meta),-  ProjectMetadata(DirProject, VirtualProject),-  ProjectType(ProjectType),-  ProjectRoot(ProjectRoot),-  ProjectName(ProjectName),-  )-import Proteome.Data.ActiveProject (ActiveProject(ActiveProject))-import Proteome.Data.Proteome (Proteome)-import Proteome.Project (currentProject, allProjects)-import qualified Proteome.Data.Env as Env (_currentProjectIndex)-import qualified Proteome.Settings as S (active)+import Exon (exon)+import Path.IO (doesDirExist)+import Ribosome (Handler, Rpc, RpcError, SettingError, Settings, pathText, resumeReport)+import Ribosome.Api (echo, nvimCommand)+import Ribosome.Data.PluginName (PluginName)+import qualified Ribosome.Settings as Settings +import Proteome.Data.ActiveProject (ActiveProject (ActiveProject))+import Proteome.Data.Env (Env)+import Proteome.Data.Project (Project (Project))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))+import Proteome.Data.ProjectType (ProjectType (ProjectType))+import Proteome.Project (allProjects, currentProject)+import qualified Proteome.Settings as Settings+ activeProject :: Project -> ActiveProject activeProject (Project (DirProject name _ tpe) _ lang _) = ActiveProject name (fromMaybe (ProjectType "none") tpe) lang activeProject (Project (VirtualProject name) _ lang _) = ActiveProject name (ProjectType "virtual") lang -activateDirProject :: ProjectMetadata -> Ribo e ()+activateDirProject ::+  Members [Rpc, Embed IO] r =>+  ProjectMetadata ->+  Sem r () activateDirProject (DirProject _ (ProjectRoot root) _) = do-  exists <- liftIO $ doesDirectoryExist root-  when exists $ vim_command' $ "chdir " ++ root-activateDirProject _ = return ()+  whenM (doesDirExist root) do+    nvimCommand [exon|chdir #{pathText root}|]+activateDirProject _ =+  unit -activateProject :: Project -> Ribo e ()-activateProject project = do-  updateSetting S.active $ activeProject project-  activateDirProject (meta project)+activateProject ::+  Members [Settings, Rpc, Embed IO] r =>+  Project ->+  Sem r ()+activateProject project@(Project meta _ _ _) = do+  Settings.update Settings.active (activeProject project)+  activateDirProject meta -describeProject :: ProjectMetadata -> String-describeProject (DirProject (ProjectName name) _ (Just (ProjectType tpe))) = tpe ++ "/" ++ name+describeProject :: ProjectMetadata -> Text+describeProject (DirProject (ProjectName name) _ (Just (ProjectType tpe))) = tpe <> "/" <> name describeProject (DirProject (ProjectName name) _ Nothing) = name describeProject (VirtualProject (ProjectName name)) = name -echoProjectActivation :: Project -> Neovim e ()-echoProjectActivation pro =-  vim_command' $ "echo 'activated project " ++ describeProject (meta pro) ++ "'"+echoProjectActivation ::+  Members [Reader PluginName, Rpc] r =>+  Project ->+  Sem r ()+echoProjectActivation (Project meta _ _ _) =+  echo [exon|activated project #{describeProject meta}|] -activateCurrentProject :: Proteome ()+activateCurrentProject ::+  Members [Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>+  Sem r () activateCurrentProject = do   pro <- currentProject   mapM_ activateProject pro   mapM_ echoProjectActivation pro -setProjectIndex :: Int -> Proteome ()+setProjectIndex ::+  Member (AtomicState Env) r =>+  Int ->+  Sem r () setProjectIndex index = do   pros <- allProjects-  Ribo.modify $ Lens.set Env._currentProjectIndex $ index `mod` length pros+  for_ (index `mod` length pros) \ i ->+    atomicModify' (#currentProjectIndex .~ i) -cycleProjectIndex :: (Int -> Int) -> Proteome ()+cycleProjectIndex ::+  Member (AtomicState Env) r =>+  (Int -> Int) ->+  Sem r () cycleProjectIndex f = do   pros <- allProjects-  let trans a = f a `rem` length pros-  Ribo.modify $ Lens.over Env._currentProjectIndex trans+  atomicModify' $ #currentProjectIndex %~ \ i -> fromMaybe i (f i `rem` length pros) -selectProject :: Int -> Proteome ()+selectProject ::+  Members [Settings, AtomicState Env, Reader PluginName, Rpc, Embed IO] r =>+  Int ->+  Sem r () selectProject index = do   setProjectIndex index   activateCurrentProject -proPrev :: CommandArguments -> Proteome ()-proPrev _ = do-  cycleProjectIndex (subtract 1)-  activateCurrentProject+proPrev ::+  Members [Settings !! SettingError, AtomicState Env, Reader PluginName, Rpc !! RpcError, Embed IO] r =>+  Handler r ()+proPrev =+  resumeReport @Rpc $ resumeReport @Settings do+    cycleProjectIndex (subtract 1)+    activateCurrentProject -proNext :: CommandArguments -> Proteome ()-proNext _ = do-  cycleProjectIndex (+1)-  activateCurrentProject+proNext ::+  Members [Settings !! SettingError, AtomicState Env, Reader PluginName, Rpc !! RpcError, Embed IO] r =>+  Handler r ()+proNext =+  resumeReport @Rpc $ resumeReport @Settings do+    cycleProjectIndex (+1)+    activateCurrentProject
lib/Proteome/Project/Resolve.hs view
@@ -1,39 +1,37 @@-{-# LANGUAGE NamedFieldPuns #-}+module Proteome.Project.Resolve where -module Proteome.Project.Resolve(-  resolveProject,-  resolveProjectFromConfig,-) where+import Control.Monad (foldM)+import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))+import Data.List (nub)+import Data.List.Extra (firstJust)+import Data.Map.Strict ((!?))+import qualified Data.Map.Strict as Map (toList, union)+import Exon (exon)+import qualified Log+import Path (Abs, Dir, Path, dirname, isProperPrefixOf, parent, parseRelDir, stripProperPrefix, toFilePath, (</>))+import Path.IO (doesDirExist)+import Ribosome (Settings)+import qualified Ribosome.Settings as Settings+import System.FilePath.Glob (globDir1)+import qualified System.FilePath.Glob as Glob (compile)+import System.FilePattern.Directory (getDirectoryFiles) -import Control.Monad (foldM, join)-import Control.Monad.Reader ((<=<))-import Control.Monad.IO.Class (liftIO)-import Data.List (find)-import Data.List.Utils (uniq)-import Data.Maybe (fromMaybe, isJust)-import Data.Map.Strict ((!?), Map)-import Safe (headMay)-import System.Directory (doesDirectoryExist)-import System.FilePath (takeDirectory, (</>))-import System.Path.Glob (glob)-import Ribosome.File (canonicalPaths)-import Ribosome.Config.Setting (setting)-import Ribosome.Data.Foldable (findMapMaybeM)-import Ribosome.Data.Maybe (orElse)-import Ribosome.Control.Ribo (Ribo)-import Proteome.Config (ProjectConfig(ProjectConfig))-import Proteome.Data.Project (-  Project(Project),-  ProjectName(..),-  ProjectRoot(..),-  ProjectType(..),-  ProjectLang(..),-  ProjectMetadata(DirProject, VirtualProject),-  )-import Proteome.Data.ProjectSpec (ProjectSpec(ProjectSpec))-import qualified Proteome.Data.ProjectSpec as PS (ProjectSpec(..))+import Proteome.Config (defaultTypeMarkers)+import Proteome.Data.Project (Project (Project))+import qualified Proteome.Data.ProjectConfig as ProjectConfig+import Proteome.Data.ProjectConfig (ProjectConfig (ProjectConfig))+import Proteome.Data.ProjectLang (ProjectLang (ProjectLang))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject, VirtualProject))+import Proteome.Data.ProjectName (ProjectName (ProjectName))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot), unProjectRoot)+import Proteome.Data.ProjectSpec (ProjectSpec (ProjectSpec))+import qualified Proteome.Data.ProjectSpec as PS (ProjectSpec (..))+import Proteome.Data.ProjectType (ProjectType (ProjectType))+import qualified Proteome.Data.ResolveError as ResolveError (ResolveError (..))+import Proteome.Data.ResolveError (ResolveError)+import Proteome.Path (dropSlash, parseAbsDirMaybe, rootPathSegment) import Proteome.Project (pathData)-import qualified Proteome.Settings as S+import qualified Proteome.Settings as Settings (projectConfig, projects)  projectFromSegments :: ProjectType -> ProjectName -> ProjectRoot -> Project projectFromSegments tpe name root =@@ -54,103 +52,270 @@ byProjectTypeName :: [ProjectSpec] -> ProjectName -> ProjectType -> Maybe ProjectSpec byProjectTypeName specs name tpe = find (hasProjectTypeName tpe name) specs -matchProjectBases :: [FilePath] -> ProjectRoot -> Bool-matchProjectBases baseDirs (ProjectRoot root) = (takeDirectory . takeDirectory) root `elem` baseDirs+matchProjectBases :: [Path Abs Dir] -> ProjectRoot -> Bool+matchProjectBases baseDirs (ProjectRoot root) = (parent . parent) root `elem` baseDirs -byProjectBaseSubpath :: ProjectName -> ProjectType -> FilePath -> IO (Maybe Project)+byProjectBaseSubpath ::+  Members [Stop ResolveError, Embed IO] r =>+  ProjectName ->+  ProjectType ->+  Path Abs Dir ->+  Sem r (Maybe Project) byProjectBaseSubpath n@(ProjectName name) t@(ProjectType tpe) base = do-  exists <- doesDirectoryExist root-  return $ if exists then Just $ projectFromSegments t n (ProjectRoot root) else Nothing-  where root = base </> tpe </> name+  tpePath <- stopEitherAs (ResolveError.ParsePath tpe) $ parseRelDir (toString tpe)+  namePath <- stopEitherAs (ResolveError.ParsePath name) $ parseRelDir (toString name)+  let root = base </> tpePath </> namePath+  exists <- doesDirExist root+  pure $ if exists then Just $ projectFromSegments t n (ProjectRoot root) else Nothing -byProjectBasesSubpath :: [FilePath] -> ProjectName -> ProjectType -> IO (Maybe Project)+byProjectBasesSubpath ::+  Members [Stop ResolveError, Embed IO] r =>+  [Path Abs Dir] ->+  ProjectName ->+  ProjectType ->+  Sem r (Maybe Project) byProjectBasesSubpath baseDirs name tpe =   foldM subpath Nothing baseDirs   where-    subpath (Just p) _ = return (Just p)+    subpath (Just p) _ = pure (Just p)     subpath Nothing a = byProjectBaseSubpath name tpe a  virtualProject :: ProjectName -> Project-virtualProject name = Project (VirtualProject name) [] Nothing []+virtualProject name =+  Project (VirtualProject name) [] Nothing [] -resolveByTypeAndPath :: [FilePath] -> ProjectName -> ProjectType -> ProjectRoot -> Maybe Project+resolveByTypeAndPath :: [Path Abs Dir] -> ProjectName -> ProjectType -> ProjectRoot -> Maybe Project resolveByTypeAndPath baseDirs name tpe root =   if matchProjectBases baseDirs root then Just (projectFromSegments tpe name root) else Nothing -resolveByType :: [FilePath] -> [ProjectSpec] -> Maybe ProjectRoot -> ProjectName -> ProjectType -> IO (Maybe Project)-resolveByType baseDirs explicit root name tpe = do+resolveByType ::+  Members [Stop ResolveError, Embed IO] r =>+  [Path Abs Dir] ->+  [ProjectSpec] ->+  ProjectName ->+  ProjectType ->+  Sem r (Maybe Project)+resolveByType baseDirs explicit name tpe = do   byBaseSubpath <- byProjectBasesSubpath baseDirs name tpe-  return $ orElse (orElse byPath byBaseSubpath) (fmap projectFromSpec byTypeName)+  pure (byBaseSubpath <|> projectFromSpec <$> byTypeName)   where-    byTypeName = byProjectTypeName explicit name tpe-    byPath = root >>= resolveByTypeAndPath baseDirs name tpe+    byTypeName =+      byProjectTypeName explicit name tpe -fromProjectRoot :: FilePath -> IO Project-fromProjectRoot dir = do-  (root, name, tpe) <- pathData dir-  return $ projectFromSegments tpe name root+fromProjectRoot :: Path Abs Dir -> Project+fromProjectRoot dir =+  projectFromSegments tpe name root+  where+    (root, name, tpe) = pathData dir -projectFromNameIn :: ProjectName -> FilePath -> IO (Maybe Project)-projectFromNameIn (ProjectName name) base = do-  candidates <- glob $ base ++ "/*/" ++ name-  mapM fromProjectRoot (headMay candidates)+projectFromNameIn ::+  Members [Stop ResolveError, Embed IO] r =>+  ProjectName ->+  Path Abs Dir ->+  Sem r (Maybe Project)+projectFromNameIn (ProjectName name) base =+  fmap fromProjectRoot . join . find isJust <$> matches+  where+    matches =+      fmap (parseAbsDirMaybe . toText) <$> glob+    glob =+      embed $ globDir1 (Glob.compile ("*/" <> toString name)) (toFilePath base) -resolveByName :: [FilePath] -> ProjectName -> IO (Maybe Project)+resolveByName ::+  Members [Stop ResolveError, Embed IO] r =>+  [Path Abs Dir] ->+  ProjectName ->+  Sem r (Maybe Project) resolveByName baseDirs name =-  findMapMaybeM (projectFromNameIn name) baseDirs+  firstJustM (projectFromNameIn name) baseDirs -resolveByRoot :: [ProjectSpec] -> ProjectRoot -> Maybe Project-resolveByRoot explicit root =-  fmap projectFromSpec byRoot+globDir ::+  Members [Stop ResolveError, Embed IO] r =>+  Path Abs Dir ->+  [Text] ->+  Sem r (Maybe FilePath)+globDir root patterns =+  (head =<<) <$> tryMaybe (getDirectoryFiles (toFilePath root) (toString <$> patterns))++resolveFromDirContents ::+  Members [Stop ResolveError, Embed IO] r =>+  Map ProjectType [Text] ->+  ProjectName ->+  ProjectRoot ->+  Sem r (Maybe Project)+resolveFromDirContents typeMarkers name projectRoot@(ProjectRoot root) =+  fmap cons <$> firstJustM match (Map.toList typeMarkers)   where-    byRoot = find (hasProjectRoot root) explicit+    cons projectType =+      projectFromSegments projectType name projectRoot+    match (tpe, patterns) =+      (tpe <$) <$> globDir root patterns -augment :: (Eq a, Ord k) => Map k [a] -> k -> [a] -> [a]+resolveByRoot ::+  Members [Stop ResolveError, Embed IO] r =>+  ProjectConfig ->+  ProjectName ->+  [ProjectSpec] ->+  ProjectRoot ->+  Sem r (Maybe Project)+resolveByRoot (ProjectConfig _ _ _ _ typeMarkers _ _) name explicit root =+  maybe (resolveFromDirContents typeMarkers name root) (pure . Just . projectFromSpec) fromExplicit+  where+    fromExplicit = find (hasProjectRoot root) explicit++augment ::+  Eq a =>+  Ord k =>+  Map k [a] ->+  k ->+  [a] ->+  [a] augment m tpe as =   case m !? tpe of-    Just extra -> uniq $ as ++ extra+    Just extra -> nub $ as ++ extra     Nothing -> as  augmentTypes :: ProjectConfig -> ProjectType -> [ProjectType] -> [ProjectType]-augmentTypes (ProjectConfig _ typeMap _ _) =+augmentTypes (ProjectConfig _ _ _ typeMap _ _ _) =   augment typeMap -realLang :: ProjectConfig -> ProjectType -> ProjectLang-realLang (ProjectConfig _ _ langMap _) t@(ProjectType tpe) =+resolveLanguage :: ProjectConfig -> ProjectType -> ProjectLang+resolveLanguage (ProjectConfig _ _ _ _ _ langMap _) t@(ProjectType tpe) =   fromMaybe (ProjectLang tpe) (langMap !? t)  augmentLangs :: ProjectConfig -> ProjectLang -> [ProjectLang] -> [ProjectLang]-augmentLangs (ProjectConfig _ _ _ langsMap) =+augmentLangs (ProjectConfig _ _ _ _ _ _ langsMap) =   augment langsMap  augmentFromConfig :: ProjectConfig -> Project -> Project augmentFromConfig config (Project meta@(DirProject _ _ (Just tpe)) types lang langs) =-  Project meta (augmentTypes config tpe types) (Just realLang') (augmentLangs config realLang' langs)+  Project meta (augmentTypes config tpe types) (Just lang') (augmentLangs config lang' langs)   where-    realLang' = fromMaybe (realLang config tpe) lang-augmentFromConfig _ project = project+    lang' = fromMaybe (resolveLanguage config tpe) lang+augmentFromConfig _ project =+  project -resolveProject ::-  [FilePath] ->+fromName ::+  Members [Stop ResolveError, Log, Embed IO] r =>   [ProjectSpec] ->   ProjectConfig ->-  Maybe ProjectRoot ->   ProjectName ->   Maybe ProjectType ->-  IO Project-resolveProject baseDirs explicit config root name tpe = do-  byType <- traverse (resolveByType baseDirs explicit root name) tpe-  byName <- if isJust root then return Nothing else resolveByName baseDirs name+  Sem r Project+fromName explicit config name tpe = do+  let baseDirs = ProjectConfig.baseDirs config+  byType <- join <$> traverse (resolveByType baseDirs explicit name) tpe+  byName <- resolveByName baseDirs name   let byNameOrVirtual = fromMaybe (virtualProject name) byName-  let byTypeOrName = fromMaybe byNameOrVirtual (join byType)-  let byRoot = root >>= resolveByRoot explicit-  let project = fromMaybe byTypeOrName byRoot-  return $ augmentFromConfig config project+  let project = fromMaybe byNameOrVirtual byType+  Log.debug (logMsg byType byName)+  pure (augmentFromConfig config project)+  where+    logMsg byType byName =+      [exon|resolved project: byType(#{show byType}) byName(#{show byName})|] -resolveProjectFromConfig :: Maybe ProjectRoot -> ProjectName -> Maybe ProjectType -> Ribo e Project-resolveProjectFromConfig root name tpe = do-  baseDirs <- (canonicalPaths <=< setting) S.projectBaseDirs-  -- typeDirs <- setting S.projectTypeDirs-  explicit <- setting S.projects-  config <- setting S.projectConfig-  liftIO $ resolveProject baseDirs explicit config root name tpe+fromNameSettings ::+  Members [Settings, Stop ResolveError, Log, Embed IO] r =>+  ProjectName ->+  Maybe ProjectType ->+  Sem r Project+fromNameSettings name tpe = do+  explicit <- Settings.get Settings.projects+  config <- projectConfig+  fromName explicit config name tpe++projectConfig ::+  Member Settings r =>+  Sem r ProjectConfig+projectConfig =+  (#typeMarkers %~ (`Map.union` defaultTypeMarkers)) <$> Settings.get Settings.projectConfig++rootExplicit :: [ProjectSpec] -> ProjectRoot -> Maybe Project+rootExplicit explicit root =+  projectFromSpec <$> find (hasProjectRoot root) explicit++rootProjectTypes ::+  Map ProjectType [Path Abs Dir] ->+  ProjectName ->+  ProjectRoot ->+  Maybe Project+rootProjectTypes tpes name root@(ProjectRoot rootDir) =+  cons . fst <$> find (elem rootDir . snd) (Map.toList tpes)+  where+    cons tpe =+      projectFromSegments tpe name root++rootTypeDirs ::+  Map ProjectType [Path Abs Dir] ->+  ProjectName ->+  ProjectRoot ->+  Maybe Project+rootTypeDirs types name root@(ProjectRoot rootDir) =+  cons . fst <$> find (matchType . snd) (Map.toList types)+  where+    cons tpe =+      projectFromSegments tpe name root+    matchType =+      any match+    match base = do+      isProperPrefixOf base rootDir++rootBaseDirs ::+  [Path Abs Dir] ->+  ProjectName ->+  ProjectRoot ->+  Maybe Project+rootBaseDirs bases name root@(ProjectRoot rootDir) =+  firstJust match bases+  where+    match base = do+      rel <- stripProperPrefix base rootDir+      let tpe = rootPathSegment (parent rel)+      if rel /= tpe+      then Just (projectFromSegments (ProjectType (dropSlash tpe)) name root)+      else Nothing++projectName :: ProjectRoot -> ProjectName+projectName =+  ProjectName . dropSlash . dirname . unProjectRoot++firstJustMOr ::+  Monad m =>+  a ->+  [m (Maybe a)] ->+  m a+firstJustMOr fallback =+  fmap (fromMaybe fallback) . runMaybeT . asum @[] . fmap MaybeT++fromRoot ::+  Members [Stop ResolveError, Embed IO] r =>+  [ProjectSpec] ->+  ProjectConfig ->+  ProjectRoot ->+  Sem r Project+fromRoot explicit config@ProjectConfig {..} root = do+  let+    byRoot =+      asum @[] [+        rootExplicit explicit root,+        rootProjectTypes projectTypes name root,+        rootTypeDirs typeDirs name root,+        rootBaseDirs baseDirs name root+        ]+  project <- firstJustMOr (virtualProject name) [+    pure byRoot,+    resolveFromDirContents typeMarkers name root+    ]+  pure (augmentFromConfig config project)+  where+    name =+      projectName root++fromRootSettings ::+  Members [Settings, Stop ResolveError, Embed IO] r =>+  ProjectRoot ->+  Sem r Project+fromRootSettings root = do+  explicit <- Settings.get Settings.projects+  config <- projectConfig+  fromRoot explicit config root
+ lib/Proteome/Quit.hs view
@@ -0,0 +1,17 @@+module Proteome.Quit where++import Conc (Lock)+import Ribosome (Handler, PersistError, Rpc, RpcError, resumeReport)+import Ribosome.Effect.Persist (Persist)++import Proteome.Data.Env (Env)+import Proteome.Data.PersistBuffers (PersistBuffers)+import Proteome.PersistBuffers (StoreBuffersLock, storeBuffers)++proQuit ::+  Member (Persist PersistBuffers !! PersistError) r =>+  Members [Lock @@ StoreBuffersLock, AtomicState Env, Rpc !! RpcError, Resource, Embed IO] r =>+  Handler r ()+proQuit =+  resumeReport @(Persist _) $ resumeReport @Rpc do+    storeBuffers
lib/Proteome/Save.hs view
@@ -1,12 +1,19 @@-module Proteome.Save(-  proSave,-) where+module Proteome.Save where -import Proteome.Data.Proteome (Proteome)-import Proteome.Tags (proTags)-import Proteome.PersistBuffers (storeBuffers)+import Conc (Lock)+import Ribosome (Reports, Handler, LogReport, PersistError, Rpc, RpcError, SettingError, Settings, resumeReport)+import Ribosome.Effect.Persist (Persist) -proSave :: Proteome ()+import Proteome.Data.Env (Env)+import Proteome.Data.PersistBuffers (PersistBuffers)+import Proteome.PersistBuffers (StoreBuffersLock, storeBuffers)+import Proteome.Tags.Gen (TagsLock, proGenTags)++proSave ::+  Member (Persist PersistBuffers !! PersistError) r =>+  Members [Settings !! SettingError, AtomicState Env, Lock @@ TagsLock, DataLog LogReport] r =>+  Members [Lock @@ StoreBuffersLock, AtomicState Env, Rpc !! RpcError, Reports, Resource, Log, Async, Embed IO] r =>+  Handler r () proSave = do-  proTags-  storeBuffers+  proGenTags+  resumeReport @Rpc $ resumeReport @(Persist _) $ storeBuffers
lib/Proteome/Settings.hs view
@@ -1,39 +1,22 @@-module Proteome.Settings(-  mainProjectDir,-  projects,-  projectTypeDirs,-  projectBaseDirs,-  projectConfig,-  mainName,-  mainType,-  tagsCommand,-  tagsArgs,-  tagsFork,-  tagsFileName,-  active,-) where+module Proteome.Settings where -import Data.Default.Class (Default(def))-import Ribosome.Config.Setting-import Proteome.Data.Project (ProjectName, ProjectType)+import Path (Abs, Dir, File, Path, Rel, relfile)+import Ribosome.Data.Setting (Setting (Setting))+ import Proteome.Data.ActiveProject (ActiveProject)+import Proteome.Data.ProjectConfig (ProjectConfig (ProjectConfig))+import Proteome.Data.ProjectName (ProjectName) import Proteome.Data.ProjectSpec (ProjectSpec)-import Proteome.Config+import Proteome.Data.ProjectType (ProjectType) -mainProjectDir :: Setting String+mainProjectDir :: Setting (Path Abs Dir) mainProjectDir = Setting "main_project_dir" True Nothing  projects :: Setting [ProjectSpec] projects = Setting "projects" True (Just []) -projectBaseDirs :: Setting [FilePath]-projectBaseDirs = Setting "project_base_dirs" True (Just [])--projectTypeDirs :: Setting [FilePath]-projectTypeDirs = Setting "project_type_dirs" True (Just [])- projectConfig :: Setting ProjectConfig-projectConfig = Setting "project_config" True (Just (ProjectConfig def def def def))+projectConfig = Setting "project_config" True (Just (ProjectConfig def def def def def def def))  mainName :: Setting ProjectName mainName = Setting "main_name" True Nothing@@ -44,14 +27,45 @@ active :: Setting ActiveProject active = Setting "active" True Nothing -tagsCommand :: Setting String+tagsEnable :: Setting Bool+tagsEnable = Setting "tags_enable" True (Just True)++tagsCommand :: Setting Text tagsCommand = Setting "tags_command" True (Just "ctags") -tagsArgs :: Setting String+tagsArgs :: Setting Text tagsArgs = Setting "tags_args" True (Just "-R --languages={langsComma} -f {tagFile} {root}")  tagsFork :: Setting Bool tagsFork = Setting "tags_fork" True (Just True) -tagsFileName :: Setting FilePath-tagsFileName = Setting "tags_file_name" True (Just ".tags")+tagsFileName :: Setting (Path Rel File)+tagsFileName = Setting "tags_file_name" True (Just [relfile|.tags|])++grepCmdline :: Setting Text+grepCmdline =+  Setting "grep_cmdline" True Nothing++filesUseRg :: Setting Bool+filesUseRg =+  Setting "files_use_rg" True (Just True)++filesExcludeHidden :: Setting Bool+filesExcludeHidden =+  Setting "files_exclude_hidden" True (Just True)++filesExcludeFiles :: Setting [Text]+filesExcludeFiles =+  Setting "files_exclude_files" True (Just [])++filesExcludeDirectories :: Setting [Text]+filesExcludeDirectories =+  Setting "files_exclude_directories" True (Just [])++filesExcludeWildIgnore :: Setting Bool+filesExcludeWildIgnore =+  Setting "files_exclude_wildignore" True (Just True)++buffersCurrentLast :: Setting Bool+buffersCurrentLast =+  Setting "buffers_current_last" True (Just False)
+ lib/Proteome/System/Path.hs view
@@ -0,0 +1,20 @@+module Proteome.System.Path where++import Path (Abs, File, Path, parseRelFile)+import Path.IO (findExecutable)++import Proteome.Data.GrepError (GrepError)+import qualified Proteome.Data.GrepError as GrepError (GrepError (NoSuchExecutable, NotInPath))++findExe ::+  Members [Stop GrepError, Embed IO] r =>+  Text ->+  Sem r (Path Abs File)+findExe exe = do+  path <- stopEitherAs parseError (parseRelFile (toString exe))+  stopNote notInPath =<< findExecutable path+  where+    parseError =+      GrepError.NoSuchExecutable exe+    notInPath =+      GrepError.NotInPath exe
− lib/Proteome/Tags.hs 
@@ -1,121 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Proteome.Tags(-  proTags,-  tagsCommand,-) where--import GHC.IO.Exception (ExitCode(..))-import Control.Monad (when)-import Control.Monad.IO.Class (liftIO)-import Control.Lens (over)-import Data.Foldable (traverse_)-import Data.List (intercalate)-import qualified Data.Map.Strict as Map (adjust)-import Data.Maybe (maybeToList)-import Data.String.Utils (replace)-import System.Process (readCreateProcessWithExitCode)-import qualified System.Process as Proc (proc, CreateProcess(cwd))-import System.FilePath ((</>))-import System.Directory (doesFileExist, removePathForcibly, renameFile)-import UnliftIO (tryIO)-import Ribosome.Config.Setting (setting)-import Ribosome.Control.Ribo (lockOrSkip)-import qualified Ribosome.Control.Ribo as Ribo (inspect, modify)-import Ribosome.Data.Errors (Errors(Errors), Error(Error), ComponentName(ComponentName))-import Ribosome.Internal.IO (forkNeovim)-import Proteome.Data.Env (Env(mainProject, projects))-import qualified Proteome.Data.Env as Env (_errors)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  Project (Project),-  ProjectLang(ProjectLang),-  ProjectRoot(ProjectRoot),-  ProjectMetadata (DirProject),-  langOrType,-  )-import qualified Proteome.Settings as S (tagsCommand, tagsArgs, tagsFork, tagsFileName)-import qualified Proteome.Log as Log--replaceFormatItem :: String -> (String, String) -> String-replaceFormatItem original (placeholder, replacement) =-  replace ("{" ++ placeholder ++ "}") replacement original--formatTagsArgs :: [ProjectLang] -> ProjectRoot -> FilePath -> String -> String-formatTagsArgs langs (ProjectRoot root) fileName formatString =-  foldl replaceFormatItem formatString formats-  where-    formats = [-      ("langsComma", intercalate "," $ fmap (\(ProjectLang l) -> l) langs),-      ("tagFile", root </> fileName),-      ("root", root)-      ]--tempname :: String -> String-tempname name = name ++ ".tmp"--deleteTags :: ProjectRoot -> Proteome ()-deleteTags (ProjectRoot root) = do-  name <- setting S.tagsFileName-  let path = root </> tempname name-  exists <- liftIO $ doesFileExist path-  when exists $ liftIO $ removePathForcibly path--replaceTags :: ProjectRoot -> Proteome ()-replaceTags (ProjectRoot root) = do-  name <- setting S.tagsFileName-  let temppath = root </> tempname name-  let path = root </> name-  _ <- liftIO $ tryIO $ renameFile temppath path-  return ()--storeError :: ComponentName -> [String] -> Errors -> Errors-storeError name msg (Errors errors) =-  Errors (Map.adjust (err:) name errors)-  where-    err = Error time msg-    time = 0--notifyError :: String -> Proteome ()-notifyError e = do-  Log.info $ "tags failed: " ++ e-  Ribo.modify $ over Env._errors (storeError (ComponentName "ctags") [e])--tagsProcess :: ProjectRoot -> String -> String -> IO (ExitCode, String, String)-tagsProcess (ProjectRoot root) cmd args =-  readCreateProcessWithExitCode (Proc.proc cmd (words args)) { Proc.cwd = Just root } ""--executeTags :: ProjectRoot -> String -> String -> Proteome ()-executeTags root@(ProjectRoot rootS) cmd args = do-  deleteTags root-  Log.debugS $ "executing tags: `" ++ cmd ++ " " ++ args ++ "` in directory " ++ rootS-  (exitcode, _, stderr) <- liftIO $ tagsProcess root cmd args-  case exitcode of-    ExitSuccess -> replaceTags root-    ExitFailure _ -> notifyError stderr--tagsCommand :: ProjectRoot -> [ProjectLang] -> Proteome (String, String)-tagsCommand root langs = do-  cmd <- setting S.tagsCommand-  args <- setting S.tagsArgs-  fileName <- setting S.tagsFileName-  return (cmd, formatTagsArgs langs root (tempname fileName) args)--regenerateTags :: ProjectRoot -> [ProjectLang] -> Proteome ()-regenerateTags root langs = do-  (cmd, args) <- tagsCommand root langs-  let thunk = executeTags root cmd args-  fork <- setting S.tagsFork-  _ <- if fork then forkNeovim thunk else thunk-  return ()--projectTags :: Project -> Proteome ()-projectTags (Project (DirProject _ root tpe) _ lang langs) =-  regenerateTags root (maybeToList (langOrType lang tpe) ++ langs)-projectTags _ = return ()--proTags :: Proteome ()-proTags = do-  main <- Ribo.inspect mainProject-  extra <- Ribo.inspect projects-  lockOrSkip "tags" $ traverse_ projectTags (main : extra)
+ lib/Proteome/Tags/Cycle.hs view
@@ -0,0 +1,96 @@+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 (CurrentLoc TagLoc {..}) =+  loadOrEdit path line++continue ::+  Member Rpc r =>+  CurrentTag ->+  Text ->+  Sem r Bool+continue CurrentTag {locations = Zipper.current -> TagLoc {..}} newName = do+  bufLine <- currentLine+  bufPath <- currentBufferPath+  pure (elem path bufPath && bufLine == line && name == newName)++cycle ::+  Members [AtomicState (Maybe CurrentTag), Rpc] r =>+  CurrentTag ->+  Sem r ()+cycle cur = do+  atomicPut (Just newCur)+  nav newCur+  where+    newCur =+      cur & #locations %~ cycleLoc++storeAndNav ::+  Members [AtomicState (Maybe CurrentTag), Rpc] r =>+  Text ->+  NonEmpty (TagLoc (Path Abs File)) ->+  Sem r ()+storeAndNav name locs = do+  atomicPut (Just cur)+  nav cur+  where+    cur =+      CurrentTag name (Zipper.fromNonEmpty locs)++start ::+  Members [AtomicState (Maybe CurrentTag), AtomicState Env, Rpc, Stop Report, Embed IO] r =>+  Text ->+  Sem r ()+start name = do+  file <- currentBufferPath+  tags <- nonEmpty <$> tagLocsPath (Just [exon|^#{name}$|]) file+  maybe (stop (Report err [err] Info)) (storeAndNav name) tags+  where+    err =+      [exon|No matching tag for #{name}|]++nextTag ::+  Members [AtomicState (Maybe CurrentTag), AtomicState Env, Rpc, Stop Report, Embed IO] r =>+  Text ->+  Sem r ()+nextTag name =+  atomicGet >>= \case+    Just cur ->+      ifM (continue cur name) (cycle cur) (start name)+    Nothing ->+      start name++cword ::+  Member Rpc r =>+  Sem r Text+cword =+  nvimCallFunction "expand" [toMsgpack @Text "<cword>"]++proNextTag ::+  Members [AtomicState (Maybe CurrentTag), AtomicState Env, Rpc !! RpcError, Embed IO] r =>+  Args ->+  Handler r ()+proNextTag =+  resumeReport . \case+    Args "" ->+      nextTag =<< cword+    Args name ->+      nextTag name
+ lib/Proteome/Tags/Gen.hs view
@@ -0,0 +1,181 @@+module Proteome.Tags.Gen where++import Conc (Lock, lockOrSkip_)+import qualified Data.List as List+import Data.Sequence ((|>))+import qualified Data.Text as Text (intercalate, replace)+import Exon (exon)+import GHC.IO.Exception (ExitCode (..))+import qualified Log+import Log (Severity (Warn))+import Path (File, Path, Rel, addExtension, toFilePath, (</>))+import Path.IO (doesFileExist, removeFile, renameFile)+import Polysemy.Process (SysProcConf, SystemProcess, SystemProcessScopeError, interpretSystemProcessNativeSingle)+import qualified Polysemy.Process.SystemProcess as Process+import Ribosome (+  Handler,+  LogReport,+  Report (Report),+  Reports,+  SettingError,+  Settings,+  mapReport,+  reportStop,+  resumeReport,+  )+import Ribosome.Report (storeReport)+import qualified Ribosome.Settings as Settings+import System.Process.Typed (proc, setWorkingDir)++import Proteome.Data.Env (Env)+import qualified Proteome.Data.Env as Env (mainProject, projects)+import Proteome.Data.Project (Project (Project), langOrType)+import Proteome.Data.ProjectLang (ProjectLang (unProjectLang))+import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))+import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))+import qualified Proteome.Data.TagsError as TagsError+import Proteome.Data.TagsError (TagsError)+import qualified Proteome.Settings as Settings++data TagsLock =+  TagsLock+  deriving stock (Eq, Show)++replaceFormatItem :: Text -> (Text, Text) -> Text+replaceFormatItem original (placeholder, replacement) =+  Text.replace ("{" <> placeholder <> "}") replacement original++formatTagsArgs ::+  [ProjectLang] ->+  ProjectRoot ->+  Path Rel File ->+  Text ->+  Text+formatTagsArgs langs (ProjectRoot root) fileName formatString =+  foldl' @[] replaceFormatItem formatString formats+  where+    formats = [+      ("langsComma", Text.intercalate "," (fmap unProjectLang langs)),+      ("tagFile", toText . toFilePath $ root </> fileName),+      ("root", toText . toFilePath $ root)+      ]++tempname ::+  Member (Stop TagsError) r =>+  Path Rel File ->+  Sem r (Path Rel File)+tempname name =+  stopEitherWith (const err) (addExtension ".tmp" name)+  where+    err =+      TagsError.TempName++deleteTempTags ::+  Members [Settings !! SettingError, Stop TagsError, Embed IO] r =>+  ProjectRoot ->+  Sem r ()+deleteTempTags (ProjectRoot root) = do+  name <- resumeHoist TagsError.Setting (Settings.get Settings.tagsFileName)+  path <- (root </>) <$> tempname name+  whenM (doesFileExist path) do+    tryAny_ (removeFile path)++replaceTags ::+  Members [Settings !! SettingError, Stop TagsError, Embed IO] r =>+  ProjectRoot ->+  Sem r ()+replaceTags (ProjectRoot root) = do+  name <- resumeHoist TagsError.Setting (Settings.get Settings.tagsFileName)+  temppath <- (root </>) <$> tempname name+  whenM (doesFileExist temppath) do+    stopTryIOError TagsError.RenameTags (renameFile temppath (root </> name))++notifyError ::+  Member Reports r =>+  [Text] ->+  Sem r ()+notifyError out =+  storeReport "tags" (Report "tag generation failed" ("tag subprocess failed: " : out) Warn)++tagsCommand ::+  Members [Settings, Stop TagsError] r =>+  ProjectRoot ->+  [ProjectLang] ->+  Sem r (Text, Text)+tagsCommand root langs = do+  cmd <- Settings.get Settings.tagsCommand+  args <- Settings.get Settings.tagsArgs+  fileName <- Settings.get Settings.tagsFileName+  tmp <- tempname fileName+  pure (cmd, formatTagsArgs langs root tmp args)++tagsProcess ::+  Members [Settings !! SettingError, Stop TagsError, Log] r =>+  ProjectRoot ->+  [ProjectLang] ->+  Sem r SysProcConf+tagsProcess projectRoot@(ProjectRoot root) langs = do+  (cmd, args) <- resumeHoist TagsError.Setting (tagsCommand projectRoot langs)+  Log.debug [exon|executing tags: `#{cmd} #{args}` in directory #{show root}|]+  pure (setWorkingDir (toFilePath root) (proc (toString cmd) (List.words (toString args))))++readStderr ::+  Member (SystemProcess !! err) r =>+  Sem r [Text]+readStderr =+  spin mempty+  where+    spin buf =+      resumeEither Process.readStderr >>= \case+        Right l -> spin (buf |> decodeUtf8 l)+        Left _ -> pure (toList buf)++executeTags ::+  Members [Settings !! SettingError, Reports, Stop TagsError, Log, Resource, Embed IO] r =>+  ProjectRoot ->+  [ProjectLang] ->+  Sem r ()+executeTags projectRoot langs = do+  deleteTempTags projectRoot+  procConf <- tagsProcess projectRoot langs+  mapStop @SystemProcessScopeError (TagsError.Process . show) $ interpretSystemProcessNativeSingle procConf do+    resumeHoist (TagsError.Process . show) Process.wait >>= \case+      ExitSuccess -> do+        Log.debug "success"+        replaceTags projectRoot+      ExitFailure _ -> do+        Log.debug "failure"+        notifyError =<< readStderr++projectTags ::+  Members [Settings !! SettingError, Settings, Reports, Stop TagsError, Log, Resource, Embed IO] r =>+  Project ->+  Sem r ()+projectTags (Project (DirProject _ root tpe) _ lang langs) =+  executeTags root (maybeToList (langOrType lang tpe) <> langs)+projectTags _ =+  unit++execution ::+  Members [Settings !! SettingError, DataLog LogReport, Async, Stop Report] r =>+  Bool ->+  Sem (Stop TagsError : r) () ->+  Sem r ()+execution = \case+  True ->+    void . async . reportStop+  False ->+    mapReport++proGenTags ::+  Members [AtomicState Env, Settings !! SettingError, DataLog LogReport, Lock @@ TagsLock, Reports] r =>+  Members [Log, Resource, Async, Embed IO] r =>+  Handler r ()+proGenTags =+  resumeReport @Settings $ whenM (Settings.get Settings.tagsEnable) do+    main <- atomicGets Env.mainProject+    extra <- atomicGets Env.projects+    fork <- Settings.get Settings.tagsFork+    execution fork $ tag $ lockOrSkip_ do+      res <- sequenceConcurrently (runStop . projectTags <$> main : extra)+      traverse (void . stopEither . fromMaybe unit) res
+ lib/Proteome/Tags/Mappings.hs view
@@ -0,0 +1,54 @@+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 (Eq, Show)++checkPath ::+  Members [Rpc, Embed IO] r =>+  Text ->+  Sem r (Maybe (Path Abs File))+checkPath path =+  runMaybeT do+    file <- MaybeT (parseNvimFile path)+    ifM (doesFileExist file) (pure file) empty++navigate ::+  Members [Rpc, ReportLog, Embed IO] r =>+  MenuWidget TagsState r TagsAction+navigate =+  withFocus' \ Tag {..} ->+    checkPath path >>= \case+      Just file ->+        pure (Menu.success (Navigate file line))+      Nothing ->+        MenuAction.Continue <$ Report.info [exon|File doesn't exist: #{path}|] [+          [exon|Tag file focused in menu doesn't exist: #{path}|]+          ]++cycleSegment :: MenuWidget TagsState r TagsAction+cycleSegment =+  menuState do+    mode . #segment %= cycle+    menuOk++mappings ::+  Members [Rpc, ReportLog, Embed IO] r =>+  Mappings TagsState r TagsAction+mappings =+  [("<cr>", navigate), ("<c-s>", cycleSegment)]
+ lib/Proteome/Tags/Menu.hs view
@@ -0,0 +1,132 @@+module Proteome.Tags.Menu where++import qualified Data.Text as Text+import Exon (exon)+import Path.IO (doesFileExist)+import Prelude hiding (tag)+import Ribosome (+  Args (Args),+  Handler,+  Report,+  Rpc,+  RpcError,+  ScratchId (ScratchId),+  SettingError,+  Settings,+  mapReport,+  pathText,+  resumeReport,+  )+import Ribosome.Host.Data.Report (ReportLog)+import Ribosome.Menu (Filter (Fuzzy), MenuItem, MenuResult, WindowMenus, modal, windowMenu)+import qualified Streamly.Prelude as Stream+import Streamly.Prelude (SerialT)++import Proteome.Data.Env (Env, mainType)+import Proteome.Menu (handleResult)+import Proteome.Tags.Cycle (cword)+import Proteome.Tags.Mappings (TagsAction (Navigate), mappings)+import Proteome.Tags.Nav (loadOrEdit)+import Proteome.Tags.Query (query)+import Proteome.Tags.State (+  RawTagSegments,+  Segment (Module, Name),+  Tag,+  TagSegments,+  TagsMode (TagsMode),+  TagsState,+  tagSegmentsFor,+  )+import Proteome.Tags.Stream (readTags)+import Proteome.Tags.Syntax (tagsSyntax)++getTags ::+  Members [AtomicState Env, Rpc] r =>+  (RawTagSegments -> TagSegments) ->+  Maybe Text ->+  Sem r (SerialT IO (MenuItem Tag))+getTags mkSegments = \case+  Just rex -> do+    Stream.fromList <$> query mkSegments rex+  Nothing ->+    readTags mkSegments++tagsAction ::+  Members [Rpc, Stop Report, Embed IO] r =>+  TagsAction ->+  Sem r ()+tagsAction = \case+  Navigate path line -> do+    unlessM (doesFileExist path) do+      stop (fromText [exon|File doesn't exist: #{pathText path}|])+    loadOrEdit path line++type TagsStack =+  [+    WindowMenus () TagsState !! RpcError,+    Settings !! SettingError,+    Rpc !! RpcError,+    Log+  ]++tagsMenu ::+  Members TagsStack r =>+  Members [AtomicState Env, Rpc, ReportLog, Stop Report, Embed IO] r =>+  Maybe Text ->+  Sem r (MenuResult TagsAction)+tagsMenu rex = do+  tpe <- atomicGets mainType+  tags <- getTags (tagSegmentsFor tpe) rex+  mapReport do+    windowMenu tags (modal (TagsMode Fuzzy mode)) (def & #items .~ scratchOptions) mappings+  where+    mode =+      if isJust rex then Module else Name+    scratchOptions =+      def+      & #name .~ ScratchId name+      & #syntax .~ [tagsSyntax]+      & #filetype ?~ name+    name =+      "proteome-tags"++tagsMenuHandle ::+  Members TagsStack r =>+  Members [AtomicState Env, Rpc, ReportLog, Stop Report, Embed IO] r =>+  Maybe Text ->+  Sem r ()+tagsMenuHandle =+  handleResult tagsAction <=< tagsMenu++proTags ::+  Members TagsStack r =>+  Members [AtomicState Env, ReportLog, Embed IO] r =>+  Args ->+  Handler r ()+proTags (Args rex) =+  resumeReport @Rpc do+    tagsMenuHandle (if Text.null rex then Nothing else Just rex)++exactQuery ::+  Member Rpc r =>+  Text ->+  Sem r Text+exactQuery =+  fmap exact . \case+    "" ->+      cword+    rex ->+      pure rex+  where+    exact rex =+      [exon|^#{rex}$|]++proTag ::+  Members TagsStack r =>+  Members [AtomicState Env, ReportLog, Embed IO] r =>+  Args ->+  Handler r ()+proTag (Args name) = do+  resumeReport @Rpc do+    rex <- exactQuery name+    tagsMenuHandle (Just rex)
+ lib/Proteome/Tags/Nav.hs view
@@ -0,0 +1,29 @@+module Proteome.Tags.Nav where++import Path (Abs, File, Path)+import Prelude hiding (tag)+import Ribosome (Buffer, Rpc)+import Ribosome.Api (bufferForFile, edit, nvimBufIsLoaded, nvimCommand, nvimGetCurrentWin, nvimWinSetBuf, setCursor)+import qualified Ribosome.Data.FileBuffer as FileBuffer++filterUnloaded ::+  Member Rpc r =>+  Buffer ->+  Sem r (Maybe Buffer)+filterUnloaded buffer =+  nvimBufIsLoaded buffer <&> \case+    True -> Just buffer+    False -> Nothing++loadOrEdit ::+  Member Rpc r =>+  Path Abs File ->+  Int ->+  Sem r ()+loadOrEdit file line = do+  existingBuffer <- join <$> (traverse (filterUnloaded . FileBuffer.buffer) =<< bufferForFile file)+  window <- nvimGetCurrentWin+  maybe (edit file) (nvimWinSetBuf window) existingBuffer+  setCursor window line 0+  nvimCommand "normal! zv"+  nvimCommand "normal! zz"
+ lib/Proteome/Tags/Query.hs view
@@ -0,0 +1,95 @@+module Proteome.Tags.Query where++import Control.Monad.Extra (mapMaybeM)+import qualified Data.Text as Text+import Exon (exon)+import Path (Abs, File, Path)+import Prelude hiding (tag)+import Ribosome (Rpc)+import Ribosome.Api (taglist)+import Ribosome.Menu (MenuItem (MenuItem))++import Proteome.Tags.Mappings (checkPath)+import qualified Proteome.Tags.State as State+import Proteome.Tags.State (+  RawTagSegments (RawTagSegments),+  Tag (Tag),+  TagLoc (TagLoc),+  TagSegments (TagSegments),+  tagLoc,+  )++truncAndPad :: Int -> Text -> Text+truncAndPad n t =+  trunced <> extra+  where+    extra =+      if tooLong then "…" else Text.replicate (diff + 1) " "+    tooLong =+      diff < 0+    diff =+      n - Text.length trunced+    trunced =+      Text.take n t++renderTag :: Tag -> Text+renderTag Tag {path, segments = TagSegments {..}} =+  [exon|#{maybe "" renderPackage package}#{fromMaybe path modulePath}|]+  where+    renderPackage p =+      [exon|📦 #{truncAndPad 20 p} |]++createTag ::+  (RawTagSegments -> TagSegments) ->+  Text ->+  Text ->+  Int ->+  Maybe (MenuItem Tag)+createTag mkSegments name path line = do+  let+    segments = mkSegments (RawTagSegments name path)+    tag = Tag {..}+    rendered = renderTag tag+  pure (MenuItem tag "" [exon| 🟣 #{truncedName} #{rendered}|])+  where+    truncedName =+      truncAndPad 20 name++parseTaglistTag ::+  (RawTagSegments -> TagSegments) ->+  TagLoc Text ->+  Maybe (MenuItem Tag)+parseTaglistTag mkSegments loc =+  createTag mkSegments (loc ^. #name) (loc ^. #path) (loc ^. #line)++tagLocs ::+  Member Rpc r =>+  Maybe Text ->+  Maybe (Path Abs File) ->+  Sem r [TagLoc Text]+tagLocs rex file = do+  result <- taglist rex file+  pure (mapMaybe tagLoc result)++checkLocPath ::+  Members [Rpc, Embed IO] r =>+  TagLoc Text ->+  Sem r (Maybe (TagLoc (Path Abs File)))+checkLocPath TagLoc {..} =+  checkPath path <&> fmap \ f -> TagLoc {path = f, ..}++tagLocsPath ::+  Members [Rpc, Embed IO] r =>+  Maybe Text ->+  Maybe (Path Abs File) ->+  Sem r [TagLoc (Path Abs File)]+tagLocsPath rex file =+  mapMaybeM checkLocPath =<< tagLocs rex file++query ::+  Member Rpc r =>+  (RawTagSegments -> TagSegments) ->+  Text ->+  Sem r [MenuItem Tag]+query mkSegments rex =+  mapMaybe (parseTaglistTag mkSegments) <$> tagLocs (Just rex) Nothing
+ lib/Proteome/Tags/State.hs view
@@ -0,0 +1,149 @@+module Proteome.Tags.State where++import Control.Lens.Regex.Text (Match, group, regex)+import Data.Char (isUpper)+import Data.List.Extra (takeWhileEnd)+import qualified Data.Text as Text+import Exon (exon)+import Lens.Micro.Extras (preview, view)+import Prelude hiding (group)+import qualified Ribosome+import Ribosome.Menu (Filter, MenuItem, Modal)+import qualified Ribosome.Menu.MenuState as MenuState+import Ribosome.Menu.MenuState (FilterMode (FilterMode), MenuMode (cycleFilter, filterMode, renderExtra, renderFilter))++import Proteome.Data.ProjectType (ProjectType (ProjectType))++data TagLoc p =+  TagLoc {+    name :: Text,+    path :: p,+    line :: Int+  }+  deriving stock (Eq, Show, Generic)++tagLoc :: Ribosome.Tag -> Maybe (TagLoc Text)+tagLoc t = do+  line <- readMaybe (toString (t ^. #cmd))+  pure TagLoc {name = t ^. #name, path = t ^. #filename, line = line - 1}++data RawTagSegments =+  RawTagSegments {+    name :: Text,+    path :: Text+  }+  deriving stock (Eq, Show, Generic)++data TagSegments =+  TagSegments {+    name :: Text,+    package :: Maybe Text,+    modulePath :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)++data Tag =+  Tag {+    path :: Text,+    line :: Int,+    segments :: TagSegments+  }+  deriving stock (Eq, Show, Generic)++data Segment =+  Name+  |+  Package+  |+  Module+  deriving stock (Eq, Show, Ord)++genericSegments :: RawTagSegments -> TagSegments+genericSegments RawTagSegments {..} =+  TagSegments {package = Nothing, modulePath = Nothing, ..}++nixPackageRegex :: Traversal' Text Match+nixPackageRegex =+  [regex|/nix/store/[^-]+-([^/]+?)(-[\d.]+)?(-tags)?/|]++nixPackage :: Text -> Maybe Text+nixPackage =+  preview (nixPackageRegex . group 0)++haskellModule :: Text -> Maybe Text+haskellModule =+  Just .+  Text.dropEnd 3 .+  Text.intercalate "." .+  takeWhileEnd firstUpper .+  Text.split ('/' ==)+  where+    firstUpper seg =+      any (isUpper . fst) (Text.uncons seg)++haskellSegments :: RawTagSegments -> TagSegments+haskellSegments RawTagSegments {..} =+  TagSegments {package = nixPackage path, modulePath = haskellModule path, ..}++tagSegmentsForProject :: ProjectType -> RawTagSegments -> TagSegments+tagSegmentsForProject = \case+  ProjectType "haskell" ->+    haskellSegments+  _ ->+    genericSegments++tagSegmentsForFile :: RawTagSegments -> TagSegments+tagSegmentsForFile segs =+  case Text.takeWhileEnd (/= '.') (segs ^. #path) of+    "hs" ->+      haskellSegments segs+    _ ->+      genericSegments segs++tagSegmentsFor :: Maybe ProjectType -> RawTagSegments -> TagSegments+tagSegmentsFor =+  maybe tagSegmentsForFile tagSegmentsForProject++renderSegment :: Segment -> Text+renderSegment = \case+  Name -> "name"+  Package -> "package"+  Module -> "module"++segmentExtract :: MenuItem Tag -> Segment -> Maybe Text+segmentExtract (view #meta -> Tag {segments = TagSegments {..}}) = \case+  Name -> Just name+  Package -> package+  Module -> modulePath++cycle :: Segment -> Segment+cycle = \case+  Name -> Package+  Package -> Module+  Module -> Name++data TagsMode =+  TagsMode {+    mode :: Filter,+    segment :: Segment+  }+  deriving stock (Eq, Show, Ord, Generic)++type TagsState =+  Modal TagsMode Tag++instance MenuMode Tag TagsMode where+  type Filter TagsMode =+    FilterMode Filter++  cycleFilter (TagsMode mode segment) =+    TagsMode (cycleFilter mode) segment++  renderFilter (TagsMode mode _) =+    renderFilter mode++  renderExtra (TagsMode _ segment) =+    Just [exon|🔧 #{renderSegment segment}|]++  filterMode (TagsMode mode segment) =+    FilterMode mode (flip segmentExtract segment)
+ lib/Proteome/Tags/Stream.hs view
@@ -0,0 +1,38 @@+module Proteome.Tags.Stream where++import qualified Data.ByteString as ByteString+import qualified Data.Text as Text+import Prelude hiding (tag)+import Ribosome (Rpc)+import Ribosome.Api (optionList)+import Ribosome.Menu (MenuItem)+import qualified Streamly.Internal.Data.Fold as Fold+import Streamly.Internal.FileSystem.File (toBytes)+import qualified Streamly.Prelude as Stream+import Streamly.Prelude (SerialT)++import Proteome.Tags.Query (createTag)+import Proteome.Tags.State (RawTagSegments, Tag, TagSegments)++parseTagLine ::+  (RawTagSegments -> TagSegments) ->+  Text ->+  Maybe (MenuItem Tag)+parseTagLine mkSegments l =+  case Text.split (== '\t') l of+    [name, path, readMaybe . toString -> Just line] ->+      createTag mkSegments name path line+    _ ->+      Nothing++readLines :: Text -> SerialT IO Text+readLines path =+  Stream.splitOnSuffix (== 10) (decodeUtf8 . ByteString.pack <$> Fold.toList) (toBytes (toString path))++readTags ::+  (RawTagSegments -> TagSegments) ->+  Member Rpc r =>+  Sem r (SerialT IO (MenuItem Tag))+readTags mkSegments = do+  files <- optionList "tags"+  pure (Stream.mapMaybe (parseTagLine mkSegments) (Stream.concatMap readLines (Stream.fromList files)))
+ lib/Proteome/Tags/Syntax.hs view
@@ -0,0 +1,10 @@+module Proteome.Tags.Syntax where++import Exon (exon)+import Ribosome.Syntax (HiLink (HiLink), Syntax, build, link, match, prefix, (#>), (>-))++tagsSyntax :: Syntax+tagsSyntax =+  (#links <>~ [HiLink "Module" "Type"]) $ build $ prefix "ProTags" $+  match "Line" "^.*$" #> match "Name" [exon|🟣 \S\+|] >- link "Directory" (match "Package" [exon|📦 \S\+|]) >-+    link "Module" (match "Module" [exon|\S\+|])
− lib/Proteome/Test/Config.hs 
@@ -1,13 +0,0 @@-module Proteome.Test.Config(-  defaultTestConfigWith,-  defaultTestConfig,-) where--import Ribosome.Test.Embed (TestConfig, Vars)-import qualified Ribosome.Test.Embed as E (defaultTestConfig, defaultTestConfigWith)--defaultTestConfigWith :: Vars -> TestConfig-defaultTestConfigWith = E.defaultTestConfigWith "proteome"--defaultTestConfig :: TestConfig-defaultTestConfig = E.defaultTestConfig "proteome"
− lib/Proteome/Test/Functional.hs 
@@ -1,18 +0,0 @@-module Proteome.Test.Functional(-  spec,-  specWith,-  fixture,-  tempDir,-  tempFile,-) where--import Ribosome.Control.Ribo (Ribo)-import Ribosome.Test.Embed (Vars)-import Ribosome.Test.Functional (functionalSpec, fixture, tempDir, tempFile)-import Proteome.Test.Config (defaultTestConfig, defaultTestConfigWith)--spec :: Ribo () () -> IO ()-spec = functionalSpec defaultTestConfig--specWith :: Ribo () () -> Vars -> IO ()-specWith thunk vars = functionalSpec (defaultTestConfigWith vars) thunk
− lib/Proteome/Test/Unit.hs 
@@ -1,27 +0,0 @@-module Proteome.Test.Unit(-  spec,-  specWith,-  specWithDef,-) where--import Data.Default.Class (def)-import UnliftIO.STM (newTVarIO)-import Ribosome.Test.Embed (Vars)-import Ribosome.Test.Unit (unitSpec)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Env (Env)-import Proteome.Test.Config (defaultTestConfig, defaultTestConfigWith)--spec :: Env -> Proteome () -> IO ()-spec e s = do-  t <- newTVarIO e-  unitSpec defaultTestConfig t s--specWith :: Env -> Proteome () -> Vars -> IO ()-specWith e s vars = do-  t <- newTVarIO e-  unitSpec (defaultTestConfigWith vars) t s--specWithDef :: Proteome () -> Vars -> IO ()-specWithDef s v = do-  specWith def s v
proteome.cabal view
@@ -1,232 +1,278 @@-cabal-version: 1.12+cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack------ hash: b09159ae62bbe57e0dc799f83b55ab8e528c986bd083975cb5dc0e7df2423fbc  name:           proteome-version:        0.3.17.0-synopsis:       neovim project manager-description:    Please see the README on GitHub at <https://github.com/tek/proteome-hs>+version:        0.9.9.9+synopsis:       Neovim Project Manager+description:    See https://hackage.haskell.org/package/proteome/docs/Proteome.html category:       Neovim-homepage:       https://github.com/tek/proteome-hs#readme-bug-reports:    https://github.com/tek/proteome-hs/issues+homepage:       https://github.com/tek/proteome#readme+bug-reports:    https://github.com/tek/proteome/issues author:         Torsten Schmits-maintainer:     tek@tryp.io-copyright:      2018 Torsten Schmits-license:        MIT+maintainer:     hackage@tryp.io+copyright:      2022 Torsten Schmits+license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple-extra-source-files:-    README.md  source-repository head   type: git-  location: https://github.com/tek/proteome-hs+  location: https://github.com/tek/proteome  library   exposed-modules:       Proteome.Add+      Proteome.Add.Syntax       Proteome.BufEnter+      Proteome.Buffers+      Proteome.Buffers.Syntax       Proteome.Config       Proteome.Data.ActiveProject+      Proteome.Data.AddError+      Proteome.Data.AddItem       Proteome.Data.AddOptions+      Proteome.Data.CurrentTag       Proteome.Data.Env+      Proteome.Data.FilenameError+      Proteome.Data.FileScanItem+      Proteome.Data.FilesConfig+      Proteome.Data.FilesError+      Proteome.Data.FilesState+      Proteome.Data.GrepError+      Proteome.Data.GrepOutputLine+      Proteome.Data.ListedBuffer+      Proteome.Data.PersistBuffers       Proteome.Data.Project+      Proteome.Data.ProjectConfig+      Proteome.Data.ProjectLang+      Proteome.Data.ProjectMetadata+      Proteome.Data.ProjectName+      Proteome.Data.ProjectRoot       Proteome.Data.ProjectSpec-      Proteome.Data.Proteome+      Proteome.Data.ProjectType+      Proteome.Data.Replace+      Proteome.Data.ReplaceError+      Proteome.Data.ResolveError+      Proteome.Data.TagsError+      Proteome.Data.TagsParams       Proteome.Diag-      Proteome.Env+      Proteome.Filename+      Proteome.Files+      Proteome.Files.Source+      Proteome.Files.Syntax+      Proteome.Grep+      Proteome.Grep.Parse+      Proteome.Grep.Process+      Proteome.Grep.Replace+      Proteome.Grep.Syntax       Proteome.Init-      Proteome.Log+      Proteome.Menu+      Proteome.Path       Proteome.PersistBuffers       Proteome.Plugin       Proteome.Project       Proteome.Project.Activate       Proteome.Project.Resolve+      Proteome.Quit       Proteome.Save       Proteome.Settings-      Proteome.Tags-      Proteome.Test.Config-      Proteome.Test.Functional-      Proteome.Test.Unit-  other-modules:-      Paths_proteome+      Proteome.System.Path+      Proteome.Tags.Cycle+      Proteome.Tags.Gen+      Proteome.Tags.Mappings+      Proteome.Tags.Menu+      Proteome.Tags.Nav+      Proteome.Tags.Query+      Proteome.Tags.State+      Proteome.Tags.Stream+      Proteome.Tags.Syntax   hs-source-dirs:       lib+  default-extensions:+      StandaloneKindSignatures+      OverloadedLabels+      ImpredicativeTypes+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin   build-depends:-      MissingH-    , aeson-    , ansi-terminal-    , base >=4.7 && <5-    , bytestring-    , containers-    , data-default-class-    , deepseq-    , directory-    , either-    , filepath-    , hslogger+      Glob+    , attoparsec+    , base >=4.12 && <5+    , chiasma+    , chronos+    , exon+    , extra+    , filepattern     , lens-    , messagepack-    , mtl-    , nvim-hs-    , pretty-terminal+    , lens-regex-pcre+    , microlens+    , nonempty-zipper+    , parsers+    , path+    , path-io+    , pcre-light+    , polysemy+    , polysemy-chronos+    , polysemy-plugin+    , polysemy-process+    , prelate >=0.1     , prettyprinter-    , process-    , resourcet+    , raw-strings-qq     , ribosome-    , safe-    , split-    , stm-    , strings-    , text-    , time+    , ribosome-host+    , ribosome-menu+    , stm-chans+    , streamly >=0.8+    , streamly-process >=0.1     , transformers-    , unliftio-    , utf8-string+    , typed-process+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)   default-language: Haskell2010  executable proteome   main-is: Main.hs-  other-modules:-      Paths_proteome   hs-source-dirs:       app-  ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      MissingH-    , aeson-    , ansi-terminal-    , base >=4.7 && <5-    , bytestring-    , containers-    , data-default-class-    , deepseq-    , directory-    , either-    , filepath-    , hslogger-    , lens-    , messagepack-    , mtl-    , nvim-hs-    , pretty-terminal-    , prettyprinter-    , process-    , proteome-    , resourcet-    , ribosome-    , safe-    , split-    , stm-    , strings-    , text-    , time-    , transformers-    , unliftio-    , utf8-string-  default-language: Haskell2010--test-suite proteome-functional-  type: exitcode-stdio-1.0-  main-is: SpecMain.hs-  other-modules:-      AddSpec-      Config-      ConfigSpec-      InitSpec-      Paths_proteome-  hs-source-dirs:-      test/f-  ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      HTF-    , MissingH-    , aeson-    , ansi-terminal-    , base >=4.7 && <5-    , bytestring-    , containers-    , data-default-class-    , deepseq-    , directory-    , either-    , filepath-    , hslogger-    , lens-    , messagepack-    , mtl-    , nvim-hs-    , pretty-terminal-    , prettyprinter-    , process-    , proteome-    , resourcet-    , ribosome-    , safe-    , split-    , stm-    , strings-    , text-    , time-    , transformers-    , unliftio-    , utf8-string-  default-language: Haskell2010--test-suite proteome-unit-  type: exitcode-stdio-1.0-  main-is: SpecMain.hs-  other-modules:-      AddSpec-      Config-      CycleSpec-      DiagSpec-      MultiTagsSpec-      PersistLoadSpec-      PersistStoreSpec-      Project-      ResolveSpec-      ScratchSpec-      TagsSpec-      Paths_proteome-  hs-source-dirs:-      test/u-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-extensions:+      StandaloneKindSignatures+      OverloadedLabels+      ImpredicativeTypes+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N   build-depends:-      HTF-    , MissingH-    , aeson-    , ansi-terminal-    , base >=4.7 && <5-    , bytestring-    , containers-    , data-default-class-    , deepseq-    , directory-    , either-    , filepath-    , hslogger-    , lens-    , messagepack-    , mtl-    , nvim-hs-    , pretty-terminal-    , prettyprinter-    , process+      base >=4.12 && <5+    , polysemy+    , polysemy-plugin+    , prelate >=0.1     , proteome-    , resourcet-    , ribosome-    , safe-    , split-    , stm-    , strings-    , text-    , time-    , transformers-    , unliftio-    , utf8-string+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)   default-language: Haskell2010
− test/f/AddSpec.hs 
@@ -1,45 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module AddSpec(-  htf_thisModulesTests,-) where--import Control.Monad.IO.Class (liftIO)-import qualified Data.Map as Map (fromList)-import System.FilePath ((</>))-import Test.Framework-import Neovim (vim_call_function', vim_command', toObject)-import Ribosome.Api.Path (nvimCwd)-import Ribosome.Config.Setting (updateSetting)-import Ribosome.Control.Ribo (Ribo)-import qualified Proteome.Settings as S (projectBaseDirs)-import Proteome.Test.Functional (specWith, fixture)-import Config (vars)--addSpec :: Ribo env ()-addSpec = do-  projectsDir <- fixture "projects"-  updateSetting S.projectBaseDirs [projectsDir]-  _ <- vim_call_function' "ProAddProject" [toObject $ Map.fromList [-    ("name", toObject "cilia"),-    ("tpe", toObject "haskell"),-    ("activate", toObject True)-    ]]-  cwd <- nvimCwd-  liftIO $ assertEqual (projectsDir </> "haskell" </> "cilia") cwd--test_addFunction :: IO ()-test_addFunction =-  vars >>= specWith addSpec--addCommandSpec :: Ribo env ()-addCommandSpec = do-  projectsDir <- fixture "projects"-  updateSetting S.projectBaseDirs [projectsDir]-  _ <- vim_command' "ProAdd! haskell/cilia"-  cwd <- nvimCwd-  liftIO $ assertEqual (projectsDir </> "haskell" </> "cilia") cwd--test_addCommand :: IO ()-test_addCommand =-  vars >>= specWith addCommandSpec
− test/f/Config.hs 
@@ -1,15 +0,0 @@-module Config(-  vars,-) where--import Neovim (toObject)-import System.Directory (getCurrentDirectory)-import Ribosome.Test.Embed (Vars(..))--vars :: IO Vars-vars = do-  base <- getCurrentDirectory-  return $ Vars [-    ("proteome_project_base_dirs", toObject [base ++ "/test/f/fixtures/projects"]),-    ("proteome_main_project_dir", toObject $ base ++ "/test/f/fixtures/projects/haskell/flagellum")-    ]
− test/f/ConfigSpec.hs 
@@ -1,23 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module ConfigSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Test.Framework-import Data.MessagePack (Object(ObjectInt))-import Neovim (vim_call_function', vim_get_var')-import Ribosome.Control.Ribo (Ribo)-import Proteome.Test.Functional (specWith)-import Config (vars)--configSpec :: Ribo env ()-configSpec = do-  _ <- vim_call_function' "ProReadConfig" []-  value <- vim_get_var' "flag"-  liftIO $ assertEqual value (ObjectInt 13)--test_config :: IO ()-test_config =-  vars >>= specWith configSpec
− test/f/InitSpec.hs 
@@ -1,25 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module InitSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Test.Framework-import Ribosome.Control.Ribo (Ribo)-import Ribosome.Config.Setting (setting)-import qualified Proteome.Settings as S-import Proteome.Data.Project (ProjectName(ProjectName), ProjectType(ProjectType))-import Proteome.Test.Functional (specWith)-import Config (vars)--initSpec :: Ribo env ()-initSpec = do-  tpe <- setting S.mainType-  name <- setting S.mainName-  liftIO $ assertEqual name (ProjectName "flagellum")-  liftIO $ assertEqual tpe (ProjectType "haskell")--test_init :: IO ()-test_init =-  vars >>= specWith initSpec
− test/f/SpecMain.hs 
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module Main where--import {-@ HTF_TESTS @-} ConfigSpec-import {-@ HTF_TESTS @-} InitSpec-import {-@ HTF_TESTS @-} AddSpec-import Test.Framework-import Test.Framework.BlackBoxTest ()--main :: IO ()-main = htfMain htf_importedTests
− test/u/AddSpec.hs 
@@ -1,37 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module AddSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import System.FilePath ((</>))-import Test.Framework-import Ribosome.Config.Setting (updateSetting)-import qualified Ribosome.Control.Ribo as Ribo (inspect)-import Ribosome.Test.Unit (fixture)-import Proteome.Data.Proteome (Proteome)-import Proteome.Add (proAdd)-import Proteome.Data.Env (projects)-import Proteome.Data.AddOptions (AddOptions(AddOptions))-import Proteome.Data.Project (-  ProjectRoot(ProjectRoot),-  ProjectMetadata(DirProject),-  Project(Project),-  )-import qualified Proteome.Settings as S (projectBaseDirs)-import Proteome.Test.Unit (specWithDef)-import Config (vars)-import Project (flag, hask, fn, tp, l)--addSpec :: Proteome ()-addSpec = do-  projectsDir <- fixture "projects"-  updateSetting S.projectBaseDirs [projectsDir]-  proAdd $ AddOptions fn tp False-  ps <- Ribo.inspect projects-  let root = projectsDir </> hask </> flag-  liftIO $ assertEqual [Project (DirProject fn (ProjectRoot root) (Just tp)) [] (Just l) []] ps--test_add :: IO ()-test_add = vars >>= specWithDef addSpec
− test/u/Config.hs 
@@ -1,15 +0,0 @@-module Config(-  vars,-) where--import Neovim (toObject)-import System.Directory (getCurrentDirectory)-import Ribosome.Test.Embed (Vars(..))--vars :: IO Vars-vars = do-  base <- getCurrentDirectory-  return $ Vars [-    ("proteome_project_base_dirs", toObject [base ++ "/test/u/fixtures/projects"]),-    ("proteome_main_project_dir", toObject $ base ++ "/test/u/fixtures/projects/haskell/flagellum")-    ]
− test/u/CycleSpec.hs 
@@ -1,48 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module CycleSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Data.Default.Class (Default(def))-import Data.Foldable (traverse_)-import System.FilePath ((</>))-import Neovim (Neovim)-import Test.Framework-import Ribosome.Api.Path (nvimCwd)-import Ribosome.Config.Setting (updateSetting)-import Ribosome.Test.Unit (fixture)-import Proteome.Add (proAdd)-import Proteome.Project.Activate (proNext, proPrev)-import Proteome.Data.AddOptions (AddOptions(AddOptions))-import Proteome.Data.Proteome (Proteome)-import Proteome.Init (resolveAndInitMain)-import qualified Proteome.Settings as S (projectBaseDirs, mainProjectDir)-import Proteome.Test.Unit (specWithDef)-import Config (vars)-import Project (cn, fn, tp, hask, prot, cil, flag)--assertProject :: FilePath -> String -> Neovim e ()-assertProject projectsDir n = do-  cwd <- nvimCwd-  liftIO $ assertEqual (projectsDir </> hask </> n) cwd--cycleSpec :: Proteome ()-cycleSpec = do-  projectsDir <- fixture "projects"-  let assertDir = assertProject projectsDir-  let mainDir = projectsDir </> hask </> prot-  updateSetting S.projectBaseDirs [projectsDir]-  updateSetting S.mainProjectDir mainDir-  resolveAndInitMain-  proAdd $ AddOptions fn tp False-  proAdd $ AddOptions cn tp False-  assertDir prot-  let checkNext n = proNext def >> assertDir n-  traverse_ checkNext [flag, cil, prot, flag]-  proPrev def-  assertDir prot--test_cycle :: IO ()-test_cycle = vars >>= specWithDef cycleSpec
− test/u/DiagSpec.hs 
@@ -1,61 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module DiagSpec(-  htf_thisModulesTests-) where--import Control.Lens (set)-import Control.Monad.IO.Class (liftIO)-import Data.Default.Class (Default(def))-import Test.Framework-import Ribosome.Api.Buffer (currentBufferContent)-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Proteome.Data.Env (_mainProject, _configLog)-import Proteome.Data.Project (-  Project (Project),-  ProjectRoot(ProjectRoot),-  ProjectMetadata (DirProject),-  )-import Proteome.Data.Proteome-import Proteome.Test.Unit (specWithDef)-import Proteome.Diag (proDiag)-import Config (vars)-import Project (fn, tp, ti, la, l, li, flag, idr, ag, hask)--root :: String-root = "/projects/flagellum"--main :: Project-main = Project (DirProject fn (ProjectRoot root) (Just tp)) [ti] (Just l) [la, li]--confLog :: [FilePath]-confLog = ["/conf/project/haskell/flagellum.vim", "/conf/project_after/all.vim"]--target :: [String]-target = [-  "Diagnostics",-  "",-  "Main project",-  "",-  "name: " ++ flag,-  "root: " ++ root,-  "type: " ++ hask,-  "tags cmd: ctags -R --languages=agda,idris -f /projects/flagellum/.tags.tmp /projects/flagellum",-  "types: " ++ idr,-  "main language: " ++ hask,-  "languages: " ++ ag ++ ", " ++ idr,-  "",-  "loaded config files:"-  ] ++ confLog--diagSpec :: Proteome ()-diagSpec = do-  Ribo.modify $ set _mainProject main-  Ribo.modify $ set _configLog confLog-  proDiag def-  content <- currentBufferContent-  liftIO $ assertEqual target content--test_diag :: IO ()-test_diag =-  vars >>= specWithDef diagSpec
− test/u/MultiTagsSpec.hs 
@@ -1,48 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module MultiTagsSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import System.FilePath ((</>))-import System.Directory (doesFileExist)-import Test.Framework-import Neovim (fromObject', vim_get_current_buffer', buffer_get_option')-import Ribosome.Config.Setting (updateSetting)-import Ribosome.Test.Unit (tempDir)-import Proteome.Data.Proteome (Proteome)-import Proteome.Add (proAdd)-import Proteome.Data.AddOptions (AddOptions(AddOptions))-import qualified Proteome.Settings as S (projectBaseDirs, tagsCommand, tagsArgs, tagsFork)-import Proteome.Tags (proTags)-import Proteome.Test.Unit (specWithDef)-import Proteome.BufEnter (bufEnter)-import Config (vars)-import Project (flag, cil, hask, cn, fn, tp, createTestProject)--multiSpec :: Proteome ()-multiSpec = do-  projectsDir <- tempDir "multi/projects"-  updateSetting S.projectBaseDirs [projectsDir]-  createTestProject tp fn-  createTestProject tp cn-  updateSetting S.tagsCommand "touch"-  updateSetting S.tagsArgs ".tags"-  updateSetting S.tagsFork False-  proAdd $ AddOptions fn tp False-  proAdd $ AddOptions cn tp False-  proTags-  bufEnter-  let ftags = projectsDir </> hask </> flag </> ".tags"-  let ctags = projectsDir </> hask </> cil </> ".tags"-  ftagsExists <- liftIO $ doesFileExist ftags-  ctagsExists <- liftIO $ doesFileExist ctags-  buf <- vim_get_current_buffer'-  tags <- buffer_get_option' buf "tags" >>= fromObject'-  liftIO $ assertEqual ftagsExists True-  liftIO $ assertEqual ctagsExists True-  liftIO $ assertEqual (ftags ++ "," ++ ctags) tags--test_multi :: IO ()-test_multi = vars >>= specWithDef multiSpec
− test/u/PersistLoadSpec.hs 
@@ -1,46 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module PersistLoadSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Control.Lens (set)-import System.FilePath ((</>))-import Test.Framework-import Neovim (vim_get_buffers', vim_get_current_buffer', buffer_get_name')-import Ribosome.Config.Setting (updateSetting)-import Ribosome.Config.Settings (persistenceDir)-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Ribosome.Test.Unit (fixture)-import Proteome.Data.Env (_mainProject)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  ProjectName(..),-  ProjectRoot(..),-  ProjectType(..),-  ProjectMetadata(DirProject),-  _meta,-  )-import Proteome.PersistBuffers (loadBuffers)-import Proteome.Test.Unit (specWithDef)-import Config (vars)--main :: ProjectMetadata-main = DirProject (ProjectName "flagellum") (ProjectRoot "") (Just (ProjectType "haskell"))--loadBuffersSpec :: Proteome ()-loadBuffersSpec = do-  Ribo.modify $ set (_mainProject._meta) main-  persistDir <- fixture "persist/load"-  fixDir <- fixture "persist/store"-  updateSetting persistenceDir persistDir-  loadBuffers-  buffers <- vim_get_buffers'-  liftIO $ assertEqual 3 (length buffers)-  active <- buffer_get_name' =<< vim_get_current_buffer'-  liftIO $ assertEqual active (fixDir </> "file2")--test_loadBuffers :: IO ()-test_loadBuffers =-  vars >>= specWithDef loadBuffersSpec
− test/u/PersistStoreSpec.hs 
@@ -1,62 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module PersistStoreSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Control.Lens (set)-import Data.Aeson (decode)-import qualified Data.ByteString.Lazy as B (readFile)-import System.FilePath ((</>))-import Test.Framework-import Ribosome.Api.Buffer (edit)-import Ribosome.Config.Setting (updateSetting)-import Ribosome.Config.Settings (persistenceDir)-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Ribosome.Test.Unit (fixture, tempDir)-import Proteome.Data.Env (_mainProject)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Project (-  ProjectName(..),-  ProjectRoot(..),-  ProjectType(..),-  ProjectMetadata(DirProject),-  _meta,-  )-import Proteome.PersistBuffers (storeBuffers, PersistBuffers(PersistBuffers))-import Proteome.Test.Unit (specWithDef)-import Config (vars)--main :: ProjectMetadata-main = DirProject (ProjectName "flagellum") (ProjectRoot "") (Just (ProjectType "haskell"))--storeTarget :: FilePath -> FilePath -> FilePath -> PersistBuffers-storeTarget f1 f2 f3 = PersistBuffers (Just f2) [f1, f2, f3]--storeBuffersSpec :: Proteome ()-storeBuffersSpec = do-  let nonexistentFile = "nonexistent"-  base <- fixture "persist/store"-  let file1 = base </> "file1"-  let file2 = base </> "file2"-  let file3 = base </> "file3"-  edit file1-  edit file2-  edit file3-  edit $ base </> nonexistentFile-  edit file2-  persistDir <- tempDir "persist/store"-  Ribo.modify $ set (_mainProject._meta) main-  updateSetting persistenceDir persistDir-  storeBuffers-  let bufferFile = persistDir </> "proteome/haskell/flagellum/buffers.json"-  json <- liftIO $ B.readFile bufferFile-  pb <- case decode json of-    Just a -> return a-    _ -> fail "invalid json"-  liftIO $ assertEqual pb (storeTarget file1 file2 file3)--test_storeBuffers :: IO ()-test_storeBuffers =-  vars >>= specWithDef storeBuffersSpec
− test/u/Project.hs 
@@ -1,76 +0,0 @@-module Project(-  flag,-  hask,-  cn,-  tp,-  l,-  fn,-  cil,-  createTestProject,-  prot,-  idr,-  ag,-  ti,-  ta,-  li,-  la,-) where--import Control.Monad.IO.Class (liftIO)-import System.FilePath ((</>))-import System.Directory (createDirectoryIfMissing)-import Ribosome.Config.Setting (setting)-import Ribosome.Control.Ribo (Ribo)-import qualified Proteome.Settings as S (projectBaseDirs)-import Proteome.Data.Project (-  ProjectName(ProjectName),-  ProjectType(ProjectType),-  ProjectLang(ProjectLang),-  )--flag :: String-flag = "flagellum"--hask :: String-hask = "haskell"--idr :: String-idr = "idris"--ag :: String-ag = "agda"--cil :: String-cil = "cilia"--prot :: String-prot = "proteome"--fn :: ProjectName-fn = ProjectName flag--cn :: ProjectName-cn = ProjectName cil--tp :: ProjectType-tp = ProjectType hask--ti :: ProjectType-ti = ProjectType idr--ta :: ProjectType-ta = ProjectType ag--l :: ProjectLang-l = ProjectLang hask--li :: ProjectLang-li = ProjectLang idr--la :: ProjectLang-la = ProjectLang ag--createTestProject :: ProjectType -> ProjectName -> Ribo e ()-createTestProject (ProjectType tpe) (ProjectName name) = do-  bases <- setting S.projectBaseDirs-  liftIO $ createDirectoryIfMissing True (head bases </> tpe </> name)
− test/u/ResolveSpec.hs 
@@ -1,70 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module ResolveSpec(-  htf_thisModulesTests-) where--import Data.Map.Strict (Map)-import qualified Data.Map as Map (fromList)-import Data.Default.Class (Default(def))-import Test.Framework-import Ribosome.File (canonicalPaths)-import Proteome.Config (ProjectConfig(ProjectConfig))-import Proteome.Data.Project (-  Project(Project),-  ProjectRoot(ProjectRoot),-  ProjectType(ProjectType),-  ProjectName(ProjectName),-  ProjectLang(ProjectLang),-  ProjectMetadata(DirProject),-  )-import Proteome.Project.Resolve (resolveProject)--paths :: [FilePath]-paths = [-  "~/../test/dir",-  "~"-  ]--test_canonicalPaths :: IO ()-test_canonicalPaths = do-  canon <- canonicalPaths paths-  assertNotEqual canon paths--root :: ProjectRoot-root = ProjectRoot "/projects/haskell/flagellum"--name :: ProjectName-name = ProjectName "flagellum"--tpe :: ProjectType-tpe = ProjectType "haskell"--tpe1 :: ProjectType-tpe1 = ProjectType "idris"--tpe2 :: ProjectType-tpe2 = ProjectType "agda"--lang :: ProjectLang-lang = ProjectLang "haskell"--lang1 :: ProjectLang-lang1 = ProjectLang "idris"--lang2 :: ProjectLang-lang2 = ProjectLang "agda"--typeMap :: Map ProjectType [ProjectType]-typeMap = Map.fromList [(tpe, [tpe1, tpe2])]--config :: ProjectConfig-config = ProjectConfig def typeMap (Map.fromList [(tpe, lang)]) (Map.fromList [(lang, [lang1, lang2])])--targetProject :: Project-targetProject = Project (DirProject name root (Just tpe)) [tpe1, tpe2] (Just lang) [lang1, lang2]--test_typeMap :: IO ()-test_typeMap = do-  project <- resolveProject ["/projects"] [] config (Just root) name (Just tpe)-  assertEqual targetProject project
− test/u/ScratchSpec.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module ScratchSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Test.Framework-import Ribosome.Api.Buffer (currentBufferContent)-import Ribosome.Data.ScratchOptions (ScratchOptions(ScratchOptions))-import Ribosome.Scratch (showInScratch)-import Proteome.Data.Proteome (Proteome)-import Proteome.Test.Unit (specWithDef)-import Config (vars)--target :: [String]-target = ["line 1", "line 2"]--scratchSpec :: Proteome ()-scratchSpec = do-  _ <- showInScratch target (ScratchOptions False True (Just 0) False "buffi")-  content <- currentBufferContent-  liftIO $ assertEqual target content--test_scratch :: IO ()-test_scratch =-  vars >>= specWithDef scratchSpec
− test/u/SpecMain.hs 
@@ -1,18 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module Main where--import {-@ HTF_TESTS @-} TagsSpec-import {-@ HTF_TESTS @-} ResolveSpec-import {-@ HTF_TESTS @-} PersistLoadSpec-import {-@ HTF_TESTS @-} PersistStoreSpec-import {-@ HTF_TESTS @-} AddSpec-import {-@ HTF_TESTS @-} MultiTagsSpec-import {-@ HTF_TESTS @-} CycleSpec-import {-@ HTF_TESTS @-} ScratchSpec-import {-@ HTF_TESTS @-} DiagSpec-import Test.Framework-import Test.Framework.BlackBoxTest ()--main :: IO ()-main = htfMain htf_importedTests
− test/u/TagsSpec.hs 
@@ -1,48 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module TagsSpec(-  htf_thisModulesTests-) where--import Control.Monad.IO.Class (liftIO)-import Control.Lens (set)-import System.FilePath ((</>))-import System.Directory (doesFileExist)-import Test.Framework-import Ribosome.Config.Setting (updateSetting)-import qualified Ribosome.Control.Ribo as Ribo (modify)-import Ribosome.Test.Unit (tempDir)-import Proteome.Data.Proteome (Proteome)-import Proteome.Data.Env (_mainProject)-import Proteome.Data.Project (-  ProjectName(..),-  ProjectRoot(..),-  ProjectType(..),-  ProjectLang(..),-  ProjectMetadata(DirProject),-  _meta,-  _lang,-  )-import qualified Proteome.Settings as S (tagsCommand, tagsArgs, tagsFork)-import Proteome.Tags (proTags)-import Proteome.Test.Unit (specWithDef)-import Config (vars)--main :: FilePath -> ProjectMetadata-main root = DirProject (ProjectName "flagellum") (ProjectRoot root) (Just (ProjectType "haskell"))--tagsSpec :: Proteome ()-tagsSpec = do-  root <- tempDir "projects/haskell/flagellum"-  Ribo.modify $ set (_mainProject._meta) (main root)-  Ribo.modify $ set (_mainProject._lang) (Just (ProjectLang "idris"))-  updateSetting S.tagsCommand "touch"-  updateSetting S.tagsArgs "tags-{langsComma}"-  updateSetting S.tagsFork False-  proTags-  let tagsFile = root </> "tags-idris"-  exists <- liftIO $ doesFileExist tagsFile-  liftIO $ assertBool exists--test_tags :: IO ()-test_tags = vars >>= specWithDef tagsSpec