diff --git a/app/Main.hs b/app/Main.hs index 587c1b1..4d73b7e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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,24 @@ 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" + +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 -> defaultCachePath + Just f -> pure f) . (.cachePath) + type Cache = HashMap String Int data CacheItem = CacheItem { name :: String @@ -44,13 +57,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 +68,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 +86,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 +95,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) diff --git a/mide.cabal b/mide.cabal index 2e23d57..1bd27be 100644 --- a/mide.cabal +++ b/mide.cabal @@ -75,6 +75,8 @@ executable mide , unordered-containers , xdg-basedir , bytestring + , process + , aeson -- Directories containing source files. hs-source-dirs: app