73 lines
2.4 KiB
Haskell
73 lines
2.4 KiB
Haskell
{-# 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)
|
|
import System.Environment.XDG.DesktopEntry
|
|
|
|
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 Item = Item { name :: String
|
|
, uses :: Int
|
|
}
|
|
deriving (Show, Generic, FromJSON, ToJSON)
|
|
|
|
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) :: [Item] -> HashMap String Int)) >>= \cache ->
|
|
runReaderT (if opts.dmenu then dmenu else normal) (config,cache)
|
|
|
|
normal :: (MonadIO m, MonadReader State m) => m ()
|
|
normal = liftIO getDirectoryEntriesDefault >>= mapM_ (liftIO . print)
|
|
|
|
dmenu :: (MonadIO m, MonadReader State m) => m ()
|
|
dmenu = undefined
|