diff --git a/app/Main.hs b/app/Main.hs index 1689644..587c1b1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/mide.cabal b/mide.cabal index c7fe35b..2e23d57 100644 --- a/mide.cabal +++ b/mide.cabal @@ -74,6 +74,7 @@ executable mide , yaml , unordered-containers , xdg-basedir + , bytestring -- Directories containing source files. hs-source-dirs: app