Now to present and get user input

This commit is contained in:
2026-03-02 23:25:32 +01:00
parent 23f52817ad
commit 40e5a6146f
2 changed files with 34 additions and 10 deletions

View File

@@ -17,8 +17,9 @@ import Data.Yaml
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Data.Functor import Data.Functor
import System.Environment.XDG.BaseDir import System.Environment.XDG.BaseDir
import Data.HashMap.Lazy (HashMap, insert) import Data.HashMap.Lazy (HashMap, insert, alter, toList)
import System.Environment.XDG.DesktopEntry import System.Environment.XDG.DesktopEntry
import qualified Data.ByteString as BS
data Options = Options { data Options = Options {
config :: Maybe FilePath, config :: Maybe FilePath,
@@ -33,11 +34,16 @@ data Config a where
type Cache = HashMap String Int type Cache = HashMap String Int
data Item = Item { name :: String data CacheItem = CacheItem { name :: String
, uses :: Int , uses :: Int
} }
deriving (Show, Generic, FromJSON, ToJSON) deriving (Show, Generic, FromJSON, ToJSON)
data Item where
AppItem :: DesktopEntry -> Item
DMenuItem :: String -> Item
deriving Show
defaultCachePath :: IO FilePath defaultCachePath :: IO FilePath
defaultCachePath = getUserCacheFile "mide" "cache.yaml" defaultCachePath = getUserCacheFile "mide" "cache.yaml"
@@ -62,11 +68,28 @@ run :: Options -> IO ()
run opts = run opts =
maybe defaultConfigPath pure opts.config >>= \configPath -> maybe defaultConfigPath pure opts.config >>= \configPath ->
decodeFileEither configPath >>= either (const $ Config . pure <$> defaultCachePath) pure >>= fixConfig >>= \config -> decodeFileEither configPath >>= either (const $ Config . pure <$> defaultCachePath) pure >>= fixConfig >>= \config ->
(decodeFileEither config.cachePath <&> either mempty ((foldr (\p -> insert p.name p.uses) mempty) :: [Item] -> HashMap String Int)) >>= \cache -> (decodeFileEither config.cachePath <&> either mempty ((foldr (\p -> insert p.name p.uses) mempty) :: [CacheItem] -> HashMap String Int)) >>= \cache ->
runReaderT (if opts.dmenu then dmenu else normal) (config,cache) runReaderT ( updateCache =<< execItem =<< presentOptions =<< if opts.dmenu then dmenu else normal) (config,cache)
normal :: (MonadIO m, MonadReader State m) => m () normal :: (MonadIO m, MonadReader State m) => m [Item]
normal = liftIO getDirectoryEntriesDefault >>= mapM_ (liftIO . print) normal = liftIO getDirectoryEntriesDefault <&> (AppItem <$>)
dmenu :: (MonadIO m, MonadReader State m) => m () dmenu :: (MonadIO m, MonadReader State m) => m [Item]
dmenu = undefined dmenu = liftIO getContents <&> (DMenuItem <$>) . lines
presentOptions :: (MonadIO m, MonadReader State m) => [Item] -> m Item
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 (print $ deCommand de)
DMenuItem s -> liftIO (putStrLn s)) >> pure i
updateCache :: (MonadIO m, MonadReader State m) => Item -> m ()
updateCache i =
let name = case i of
AppItem d -> deName [] d
DMenuItem s -> s in
ask >>= \(conf, hmap) ->
liftIO . encodeFile conf.cachePath . map (uncurry CacheItem) . toList $
alter (\case Nothing -> pure 1; Just x -> pure (x+1)) name hmap

View File

@@ -74,6 +74,7 @@ executable mide
, yaml , yaml
, unordered-containers , unordered-containers
, xdg-basedir , xdg-basedir
, bytestring
-- Directories containing source files. -- Directories containing source files.
hs-source-dirs: app hs-source-dirs: app