Now to present and get user input

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