This commit is contained in:
2026-03-04 16:49:51 +01:00
parent 3b46a4eace
commit d264b95ac0
3 changed files with 30 additions and 14 deletions

View File

@@ -14,11 +14,20 @@ import WithCli
import Control.Monad.Reader
import Data.Yaml
import Data.Functor
import Data.Maybe
import System.Environment.XDG.BaseDir
import Data.HashMap.Lazy (HashMap, insert, alter, toList)
import System.Environment.XDG.DesktopEntry
import System.Process
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Brick
import qualified Brick.Widgets.Edit as BE
import qualified Brick.Widgets.List as BL
import Data.List
(|>) :: (a -> b) -> (b -> c) -> a -> c
(|>) = flip (.)
data Options = Options {
config :: Maybe FilePath,
@@ -41,20 +50,20 @@ class Config a where
cachePath :: a -> IO FilePath
instance Config TConfig where
cachePath = (\case
cachePath = (.cachePath) |> \case
Nothing -> defaultCachePath
Just f -> pure f) . (.cachePath)
Just f -> pure f
type Cache = HashMap String Int
type Cache = HashMap Text Int
data CacheItem = CacheItem { name :: String
data CacheItem = CacheItem { name :: Text
, uses :: Int
}
deriving (Show, Generic, FromJSON, ToJSON)
data Item where
AppItem :: DesktopEntry -> Item
DMenuItem :: String -> Item
DMenuItem :: Text -> Item
deriving Show
type State = (TConfig, Cache)
@@ -71,15 +80,16 @@ main = withCliModified [ AddShortOption "config" 'c',
run :: Options -> IO ()
run opts =
maybe defaultConfigPath pure opts.config >>= \configPath ->
decodeFileEither configPath >>= either (const $ Config . pure <$> defaultCachePath) pure >>= \config ->
(cachePath config >>= decodeFileEither <&> either mempty ((foldr (\p -> insert p.name p.uses) mempty) :: [CacheItem] -> HashMap String Int)) >>= \cache ->
runReaderT ( updateCache =<< execItem =<< presentOptions =<< if opts.dmenu then dmenu else normal) (config,cache)
decodeFileEither configPath >>= either (const $ Config . pure <$> defaultCachePath) pure >>=
(\Config{..} -> pure Config{cachePath = maybe cachePath pure opts.cache, ..}) >>= \config ->
(cachePath config >>= decodeFileEither <&> either mempty (foldr (\p -> insert p.name p.uses) mempty :: [CacheItem] -> HashMap Text Int)) >>= \cache ->
flip runReaderT (config,cache) (updateCache =<< execItem =<< presentOptions =<< if opts.dmenu then dmenu else normal)
normal :: (MonadIO m, MonadReader State m) => m [Item]
normal = liftIO getDirectoryEntriesDefault <&> (AppItem <$>)
dmenu :: (MonadIO m, MonadReader State m) => m [Item]
dmenu = liftIO getContents <&> (DMenuItem <$>) . lines
dmenu = liftIO T.getContents <&> (DMenuItem <$>) . T.lines
presentOptions :: (MonadIO m, MonadReader State m) => [Item] -> m Item
presentOptions ls = mapM_ (liftIO . print) ls >> pure (head ls)
@@ -87,13 +97,19 @@ presentOptions ls = mapM_ (liftIO . print) ls >> pure (head ls)
execItem :: (MonadIO m, MonadReader State m) => Item -> m Item
execItem i = (case i of
AppItem de -> liftIO (maybe undefined (void . spawnCommand) (deCommand de))
DMenuItem s -> liftIO (putStrLn s)) >> pure i
DMenuItem s -> liftIO (T.putStrLn s)) >> pure i
updateCache :: (MonadIO m, MonadReader State m) => Item -> m ()
updateCache i =
let name = case i of
AppItem d -> deName [] d
AppItem d -> T.pack $ deName [] d
DMenuItem s -> s in
ask >>= \(conf, hmap) ->
liftIO (cachePath conf >>= \path -> encodeFile path . map (uncurry CacheItem) . toList $
alter (\case Nothing -> pure 1; Just x -> pure (x+1)) name hmap)
data Controls = TextSearch | ListResults
data AppS = AppS { appEditText :: BE.Editor Text Controls
, appItems :: [Item]
}

View File

@@ -78,8 +78,6 @@
#
# don't check version bounds
# constraints = hlib.doJailbreak hprev.constraints;
# ghc-prim = hlib.doJailbreak hprev.ghc-prim;
# text = hlib.doJailbreak hprev.text;
});
};
};

View File

@@ -77,6 +77,8 @@ executable mide
, bytestring
, process
, aeson
, text
, brick
-- Directories containing source files.
hs-source-dirs: app