packages feed

seihou-cli-0.6.0.0: src/Seihou/Fzf/Selector/Module.hs

module Seihou.Fzf.Selector.Module
  ( formatModuleCandidate,
    formatRunnableCandidate,
    defaultModuleOpts,
    selectModule,
  )
where

import Data.Generics.Labels ()
import Data.Maybe (mapMaybe)
import Data.Text qualified as T
import Seihou.Core.Module (DiscoveredModule (..), DiscoveredRunnable (..), ModuleSource (..), RunnableKind (..), defaultSearchPaths, discoverAllModules, discoverAllRunnables)
import Seihou.Core.Types
import Seihou.Effect.Fzf (Fzf, selectOne)
import Seihou.Fzf (Candidate (..), FzfOpts, FzfResult, withAnsi, withHeight, withNoSort, withPrompt)
import Seihou.Prelude

-- | Format a discovered module as an fzf candidate.
-- Returns 'Nothing' for modules that failed to load.
formatModuleCandidate :: DiscoveredModule -> Maybe (Candidate ModuleName)
formatModuleCandidate dm = case dm ^. #result of
  Left _ -> Nothing
  Right m ->
    let nameText = (m ^. #name . #unModuleName)
        descText = maybe "" (\d -> "  " <> d) (m ^. #description)
        sourceTag = case dm ^. #source of
          SourceProject -> "[project]"
          SourceUser -> "[user]"
          SourceInstalled -> "[installed]"
        display = nameText <> descText <> "  " <> sourceTag
     in Just Candidate {display = display, value = m ^. #name}

-- | Format a discovered runnable (module or recipe) as an fzf candidate.
-- Returns 'Nothing' for items that failed to load.
formatRunnableCandidate :: DiscoveredRunnable -> Maybe (Candidate ModuleName)
formatRunnableCandidate dr
  | (dr ^. #isError) = Nothing
  | otherwise =
      let nameText = (dr ^. #name)
          descText = maybe "" (\d -> "  " <> d) (dr ^. #description)
          kindTag = case dr ^. #kind of
            KindModule -> ""
            KindRecipe -> " [recipe]"
            KindBlueprint -> " [blueprint]"
            KindPrompt -> " [prompt]"
          sourceTag = case dr ^. #source of
            SourceProject -> "[project]"
            SourceUser -> "[user]"
            SourceInstalled -> "[installed]"
          display = nameText <> descText <> kindTag <> "  " <> sourceTag
       in Just Candidate {display = display, value = ModuleName nameText}

-- | Default fzf options for module selection.
defaultModuleOpts :: FzfOpts
defaultModuleOpts = withPrompt "module> " <> withHeight "40%" <> withAnsi <> withNoSort

-- | Discover all available modules and recipes and present them in an fzf picker.
selectModule :: (Fzf :> es, IOE :> es) => Eff es (FzfResult ModuleName)
selectModule = do
  searchPaths <- liftIO defaultSearchPaths
  discovered <- liftIO (discoverAllRunnables searchPaths)
  let candidates = mapMaybe formatRunnableCandidate discovered
  selectOne defaultModuleOpts candidates