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 Data.Functor
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 qualified Data.ByteString as BS
data Options = Options {
config :: Maybe FilePath,
@@ -33,11 +34,16 @@ data Config a where
type Cache = HashMap String Int
data Item = Item { name :: String
, uses :: Int
}
data CacheItem = CacheItem { name :: String
, uses :: Int
}
deriving (Show, Generic, FromJSON, ToJSON)
data Item where
AppItem :: DesktopEntry -> Item
DMenuItem :: String -> Item
deriving Show
defaultCachePath :: IO FilePath
defaultCachePath = getUserCacheFile "mide" "cache.yaml"
@@ -62,11 +68,28 @@ run :: Options -> IO ()
run opts =
maybe defaultConfigPath pure opts.config >>= \configPath ->
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 ->
runReaderT (if opts.dmenu then dmenu else normal) (config,cache)
(decodeFileEither config.cachePath <&> 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)
normal :: (MonadIO m, MonadReader State m) => m ()
normal = liftIO getDirectoryEntriesDefault >>= mapM_ (liftIO . print)
normal :: (MonadIO m, MonadReader State m) => m [Item]
normal = liftIO getDirectoryEntriesDefault <&> (AppItem <$>)
dmenu :: (MonadIO m, MonadReader State m) => m ()
dmenu = undefined
dmenu :: (MonadIO m, MonadReader State m) => m [Item]
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
, unordered-containers
, xdg-basedir
, bytestring
-- Directories containing source files.
hs-source-dirs: app