50 lines
1.7 KiB
Haskell
50 lines
1.7 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
|
|
|
import Relude
|
|
import Witch
|
|
|
|
import Data.Aeson (FromJSON (..), Value (Array, String), withObject)
|
|
import qualified Data.Aeson.Key as Key
|
|
import qualified Data.Aeson.KeyMap as Aeson
|
|
import qualified Data.Foldable as Foldable
|
|
import qualified Data.Text as Text
|
|
import Data.Yaml (decodeFileEither)
|
|
|
|
import System.Posix.Daemon (Redirection (DevNull), runDetached)
|
|
import System.Process (callCommand)
|
|
|
|
import Dialog (Menu (..), MenuEntry (Option, SubMenu), menu, runClearingHaskeline)
|
|
|
|
data Command = Run Text | Fork Text deriving (Show)
|
|
|
|
instance FromJSON (Menu Command) where
|
|
parseJSON = parseMenu "Hotkeys"
|
|
where
|
|
parseList name = (fmap (Menu name) .) $
|
|
mapM $ \(Key.toText -> key, val) ->
|
|
case val of
|
|
String cmd -> pure $ Dialog.Option key (text2cmd cmd)
|
|
innerObj -> Dialog.SubMenu <$> parseMenu key innerObj
|
|
unpackMenu (Array arr) = join <$> mapM unpackMenu (reverse $ Foldable.toList arr)
|
|
unpackMenu value = withObject "mapping to menu entries" (pure . reverse . Aeson.toList) value
|
|
parseMenu name = parseList name <=< unpackMenu
|
|
text2cmd t = if Text.isPrefixOf "fork " t then Fork (Text.drop 5 t) else Run t
|
|
|
|
main :: IO ()
|
|
main = do
|
|
[menuFileName] <- getArgs
|
|
menuCommand <- decodeFileEither menuFileName
|
|
case menuCommand of
|
|
Left err -> print err
|
|
Right a -> do
|
|
cmd <- runClearingHaskeline $ menu Nothing a
|
|
maybe pass runCommand cmd
|
|
|
|
runCommand :: Command -> IO ()
|
|
runCommand (Run cmd) = callCommand $ into cmd
|
|
runCommand (Fork cmd) = runDetached Nothing DevNull (callCommand $ into cmd)
|