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

import WithCli
import Data.Maybe
import Control.Monad.Reader
import Data.Yaml
import GHC.Generics (Generic)
import Data.Functor
import System.Environment.XDG.BaseDir
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,
     cache :: Maybe FilePath,
     dmenu :: Bool
   }
   deriving (Show, Generic, HasArguments)

data Config a where
  Config :: { cachePath :: a } -> Config a
  deriving (Show, Generic, FromJSON, ToJSON)

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

defaultCachePath :: IO FilePath
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',
                         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

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 ->
  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 (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