{-# LANGUAGE DeriveAnyClass,
             DeriveGeneric,
             DerivingVia,
             DuplicateRecordFields,
             LambdaCase,
             GADTs,
             NoFieldSelectors,
             OverloadedRecordDot,
             RecordWildCards,
             OverloadedStrings #-}
module Main (main) where

import WithCli
import Control.Monad.Reader
import Data.Yaml
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 System.Process

data Options = Options {
     config :: Maybe FilePath,
     cache :: Maybe FilePath,
     dmenu :: Bool
   }
   deriving (Show, Generic, HasArguments)

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
                           , uses :: Int
                           }
  deriving (Show, Generic, FromJSON, ToJSON)

data Item where
  AppItem :: DesktopEntry -> Item
  DMenuItem :: String -> Item
  deriving Show

type State = (TConfig, Cache)

main :: IO ()
main = withCliModified [ AddShortOption "config" 'c',
                         AddShortOption "dmenu" 'd',
                         AddOptionHelp "config" "Point to the file containing yaml for configuration",
                         AddOptionHelp "cache" "Point to the file containing yaml for cache",
                         AddOptionHelp "dmenu" "Run in dmenu version"
                       ]
                       run

run :: Options -> IO ()
run opts =
  maybe defaultConfigPath pure opts.config >>= \configPath ->
   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]
normal = liftIO getDirectoryEntriesDefault <&> (AppItem <$>)

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 (maybe undefined (void . spawnCommand) (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 (cachePath conf >>= \path -> encodeFile path . map (uncurry CacheItem) . toList $
        alter (\case Nothing -> pure 1; Just x -> pure (x+1)) name hmap)