pingu/mide
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Worse config, my beloved

Browse Source
This commit is contained in:
pingu
2026-03-03 11:37:41 +01:00
parent 40e5a6146f
commit 6a6b438f85
2 changed files with 29 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
app/Main.hs
View File

@@ -11,15 +11,14 @@
module Main (main) where
import WithCli
import Data.Maybe
import Control.Monad.Reader
import Data.Yaml
import GHC.Generics (Generic)
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 qualified Data.ByteString as BS
import System.Process
data Options = Options {
config :: Maybe FilePath,
@@ -28,10 +27,27 @@ data Options = Options {
}
deriving (Show, Generic, HasArguments)
data Config a where
Config :: { cachePath :: a } -> Config a
defaultCachePath :: IO FilePath
defaultCachePath = getUserCacheFile "mide" "cache.yaml"
defaultConfigPath :: IO FilePath
defaultConfigPath = getUserConfigFile "mide" "config.yaml"
defaultConfig :: IO TConfig
defaultConfig = Config <$> (pure <$> defaultCachePath)
data TConfig where
Config :: { cachePath :: Maybe FilePath } -> TConfig
deriving (Show, Generic, FromJSON, ToJSON)
class Config a where
cachePath :: a -> IO FilePath
instance Config TConfig where
cachePath = (\case
Nothing -> defaultConfig <&> fromJust . (.cachePath)
Just f -> pure f) . (.cachePath)
type Cache = HashMap String Int
data CacheItem = CacheItem { name :: String
@@ -44,13 +60,7 @@ data Item where
DMenuItem :: String -> Item
deriving Show
defaultCachePath :: IO FilePath
defaultCachePath = getUserCacheFile "mide" "cache.yaml"
defaultConfigPath :: IO FilePath
defaultConfigPath = getUserConfigFile "mide" "config.yaml"
type State = (Config FilePath, Cache)
type State = (TConfig, Cache)
main :: IO ()
main = withCliModified [ AddShortOption "config" 'c',
@@ -61,14 +71,11 @@ main = withCliModified [ AddShortOption "config" 'c',
]
run
fixConfig :: Config (Maybe FilePath) -> IO (Config FilePath)
fixConfig Config{..} = maybe (defaultCachePath <&> Config) (pure . Config) cachePath
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) :: [CacheItem] -> HashMap String Int)) >>= \cache ->
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)
normal :: (MonadIO m, MonadReader State m) => m [Item]
@@ -82,7 +89,7 @@ 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)
AppItem de -> liftIO (maybe undefined (void . spawnCommand) (deCommand de))
DMenuItem s -> liftIO (putStrLn s)) >> pure i
updateCache :: (MonadIO m, MonadReader State m) => Item -> m ()
@@ -91,5 +98,5 @@ updateCache i =
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
liftIO (cachePath conf >>= \path -> encodeFile path . map (uncurry CacheItem) . toList $
alter (\case Nothing -> pure 1; Just x -> pure (x+1)) name hmap)