Worse config, my beloved

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
+defaultCachePath :: IO FilePath
-  Config :: { cachePath :: a } -> Config a
+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
+type State = (TConfig, Cache)
-defaultCachePath = getUserCacheFile "mide" "cache.yaml"
-
-defaultConfigPath :: IO FilePath
-defaultConfigPath = getUserConfigFile "mide" "config.yaml"
-
-type State = (Config FilePath, 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 configPath >>= either (const $ Config . pure <$> defaultCachePath) pure >>= \config ->
-  (decodeFileEither config.cachePath <&> either mempty ((foldr (\p -> insert p.name p.uses) mempty) :: [CacheItem] -> HashMap String Int)) >>= \cache ->
+  (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 $
+  liftIO (cachePath conf >>= \path -> encodeFile path . map (uncurry CacheItem) . toList $
-  alter (\case Nothing -> pure 1; Just x -> pure (x+1)) name hmap
+        alter (\case Nothing -> pure 1; Just x -> pure (x+1)) name hmap)

mide.cabal

@@ -75,6 +75,8 @@ executable mide
                   , unordered-containers
                   , xdg-basedir
                   , bytestring
+                  , process
+                  , aeson
 
     -- Directories containing source files.
     hs-source-dirs:   app