116 lines
3.8 KiB
Haskell
116 lines
3.8 KiB
Haskell
{-# 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 System.Environment.XDG.BaseDir
|
|
import Data.HashMap.Lazy (HashMap, insert, alter, toList)
|
|
import System.Environment.XDG.DesktopEntry
|
|
import System.Process
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as T
|
|
import Brick
|
|
import qualified Brick.Widgets.Edit as BE
|
|
import qualified Brick.Widgets.List as BL
|
|
import Data.List
|
|
|
|
(|>) :: (a -> b) -> (b -> c) -> a -> c
|
|
(|>) = flip (.)
|
|
|
|
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"
|
|
|
|
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 = (.cachePath) |> \case
|
|
Nothing -> defaultCachePath
|
|
Just f -> pure f
|
|
|
|
type Cache = HashMap Text Int
|
|
|
|
data CacheItem = CacheItem { name :: Text
|
|
, uses :: Int
|
|
}
|
|
deriving (Show, Generic, FromJSON, ToJSON)
|
|
|
|
data Item where
|
|
AppItem :: DesktopEntry -> Item
|
|
DMenuItem :: Text -> 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{..} -> pure Config{cachePath = maybe cachePath pure opts.cache, ..}) >>= \config ->
|
|
(cachePath config >>= decodeFileEither <&> either mempty (foldr (\p -> insert p.name p.uses) mempty :: [CacheItem] -> HashMap Text Int)) >>= \cache ->
|
|
flip runReaderT (config,cache) (updateCache =<< execItem =<< presentOptions =<< if opts.dmenu then dmenu else normal)
|
|
|
|
normal :: (MonadIO m, MonadReader State m) => m [Item]
|
|
normal = liftIO getDirectoryEntriesDefault <&> (AppItem <$>)
|
|
|
|
dmenu :: (MonadIO m, MonadReader State m) => m [Item]
|
|
dmenu = liftIO T.getContents <&> (DMenuItem <$>) . T.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 (T.putStrLn s)) >> pure i
|
|
|
|
updateCache :: (MonadIO m, MonadReader State m) => Item -> m ()
|
|
updateCache i =
|
|
let name = case i of
|
|
AppItem d -> T.pack $ 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)
|
|
|
|
data Controls = TextSearch | ListResults
|
|
|
|
data AppS = AppS { appEditText :: BE.Editor Text Controls
|
|
, appItems :: [Item]
|
|
}
|