systranything (empty) → 0.1.0.0
raw patch · 20 files changed
+694/−0 lines, 20 filesdep +aesondep +basedep +bytestringbinary-added
Dependencies added: aeson, base, bytestring, extra, gi-ayatana-appindicator3, gi-gdk, gi-glib, gi-gobject, gi-gtk, optparse-applicative, text, typed-process, unliftio, yaml
Files
- CHANGELOG.md +4/−0
- LICENSE +21/−0
- README.md +78/−0
- cabal.project +2/−0
- demo.gif binary
- systranything.cabal +86/−0
- systranything/Main.hs +39/−0
- systranything/Model/Checkbox.hs +42/−0
- systranything/Model/Command.hs +41/−0
- systranything/Model/Common.hs +34/−0
- systranything/Model/Indicator.hs +64/−0
- systranything/Model/Internal.hs +13/−0
- systranything/Model/Item.hs +65/−0
- systranything/Model/Label.hs +25/−0
- systranything/Model/RadioButton.hs +23/−0
- systranything/Model/RadioGroup.hs +59/−0
- systranything/Model/Root.hs +18/−0
- systranything/Model/SubMenu.hs +26/−0
- systranything/Model/SubMenu.hs-boot +14/−0
- systranything/Options.hs +40/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+# 0.1.0.0++First version+
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2023 Jean-Charles Quillet++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,78 @@+# Systranything++[![nix][status-nix-png]][status-nix] +[![haskell-ci][status-haskell-ci-png]][status-haskell-ci]++`systranything` lets you put anything in your system tray. It is supported by +all destop environment that implements the [StatusNotifierHost +specification][status-notifier-host] from [freedesktop.org][freedesktop] +([KDE][kde], [XFCE][xfce], ...).++It uses a YAML file which describes the icon to put in the system tray along a +context menu and callbacks to be executed in a shell.++The menu can contain labels, separators, submenus, checkboxes and radiobuttons. +Scroll events can be triggered on the main icon.++Among other things, I use it to change my VPN settings. The icon shows its +current status:++++What you can do with it:++- a custom launcher menu+- a volume icon+- a menu to turn on or off your VPN+- a menu to toggle dual monitor setups+- anything that requires a status icon and scriptable actions++See [the example file](example.yaml) to get started.++Run it with:++```bash+$ systranything -f ./example.yaml+```++It has a verbose mode which can be turned on with `-v`. It writes on `stdout` +the commands executed along their outputs.++# Hacking++The project can be built with [nix][nix].++Install with:++```bash+$ nix profile install+```++Build with:++```bash+$ nix build+```++The binary is then created in `./result/bin/systranything`++Hack with:++```bash+$ nix develop+```++You will be dropped in a shell with all the needed tools in scope: `cabal` to +build the project and `haskell-language-server` for a better developer +experience.++[freedesktop]: https://www.freedesktop.org/wiki/+[kde]: https://kde.org/+[nix]: https://nixos.org/+[polybar]: https://polybar.github.io/+[status-notifier-host]: https://www.freedesktop.org/wiki/Specifications/StatusNotifierItem/StatusNotifierHost/+[status-nix-png]: https://github.com/jecaro/systranything/workflows/nix/badge.svg+[status-haskell-ci-png]: https://github.com/jecaro/systranything/workflows/Haskell-CI/badge.svg+[xfce]: https://www.xfce.org/+[status-nix]: https://github.com/jecaro/systranything/actions/workflows/nix.yml+[status-haskell-ci]: https://github.com/jecaro/systranything/actions/workflows/haskell-ci.yml
+ cabal.project view
@@ -0,0 +1,2 @@+packages: .+max-backjumps: 5000
+ demo.gif view
binary file changed (absent → 1355321 bytes)
+ systranything.cabal view
@@ -0,0 +1,86 @@+cabal-version: 2.2++name: systranything+version: 0.1.0.0+synopsis: Let you put anything in the system tray+homepage: https://github.com/jecaro/systranything+author: Jean-Charles Quillet+maintainer: jeancharles.quillet@gmail.com+license: MIT+license-file: LICENSE+category: Desktop+build-type: Simple+description:+ `systranything` creates a system tray menu based on a YAML file. The YAML+ contains the specification of the menu items with shell commands to execute+ when the items are clicked.+tested-with:+ GHC == 9.2.8,+ GHC == 9.4.5,+ GHC == 9.6.2+extra-source-files:+ cabal.project+extra-doc-files:+ CHANGELOG.md+ README.md+ demo.gif++source-repository head+ type: git+ location: https://github.com/jecaro/systranything.git++executable systranything+ main-is:+ Main.hs+ hs-source-dirs:+ systranything+ other-modules:+ Model.Checkbox+ Model.Command+ Model.Common+ Model.Indicator+ Model.Internal+ Model.Item+ Model.Label+ Model.RadioGroup+ Model.RadioButton+ Model.Root+ Model.SubMenu+ Options+ build-depends:+ aeson >= 2.1.2 && < 2.2,+ base >= 4.16 && < 5,+ bytestring >= 0.11.4 && < 0.12,+ extra >= 1.7.14 && < 1.8,+ gi-ayatana-appindicator3 >= 0.1.0 && < 0.2,+ gi-gdk >= 3.0.28 && < 3.1,+ gi-glib >= 2.0.29 && < 2.1,+ gi-gobject >= 2.0.30 && < 2.1,+ gi-gtk >= 3.0.39 && < 3.1,+ optparse-applicative >= 0.17.1 && < 0.18,+ text >= 2.0.2 && < 2.1,+ typed-process >= 0.2.11 && < 0.3,+ unliftio >= 0.2.25 && < 0.3,+ yaml >= 0.11.11 && < 0.12,+ default-language:+ Haskell2010+ default-extensions:+ DeriveGeneric+ DerivingStrategies+ OverloadedLabels+ OverloadedStrings+ RecordWildCards+ ScopedTypeVariables+ StrictData+ TupleSections+ ghc-options:+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wpartial-fields+ -Wredundant-constraints+ -Wunused-packages+ -threaded+ -with-rtsopts=-N
+ systranything/Main.hs view
@@ -0,0 +1,39 @@+module Main (main) where++import Control.Exception (Exception (..), SomeException)+import Control.Monad (void)+import Data.Yaml (decodeFileThrow, prettyPrintParseException)+import qualified GI.GLib as GLib+import qualified GI.Gtk as Gtk+import Model.Indicator (newIndicator)+import Model.Item (populate)+import Model.Root (Root (..))+import Options (Options (..), parseArgs)+import System.Exit (exitFailure)+import System.IO (hPutStr, stderr)+import UnliftIO (handleAny)++main :: IO ()+main = do+ MkOptions {..} <- parseArgs++ handleAny exceptions $ do+ MkRoot {..} <- decodeFileThrow opFilename++ void . Gtk.init $ Nothing++ mbMenu <- traverse (populate opVerbose) roMenu+ indicator <- newIndicator opVerbose roIndicator mbMenu++ -- Make sure the indicator is not garbage collected. That's mandatory for+ -- the case when there is no periodic update to keep the indicator alive.+ Gtk.withManagedPtr indicator . const $+ GLib.mainLoopRun =<< GLib.mainLoopNew Nothing False++exceptions :: SomeException -> IO ()+exceptions e = hPutStr stderr message >> exitFailure+ where+ message+ | Just parseException <- fromException e =+ prettyPrintParseException parseException <> "\n"+ | otherwise = "Unknown exception: " <> show e
+ systranything/Model/Checkbox.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.Checkbox (Checkbox (..), newItem) where++import Control.Monad (void)+import Data.Aeson.TH (deriveJSON)+import Data.Text (Text)+import qualified Data.Text as T+import Foreign.C (CULong)+import GHC.Generics (Generic)+import qualified GI.GObject as GObject+import qualified GI.Gtk as Gtk+import Model.Common (runCommand)+import Model.Internal (options)++data Checkbox = MkCheckbox+ { chLabel :: Text,+ chOnClick :: Text,+ chOnGetStatus :: Text+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''Checkbox)++newItem :: Bool -> Checkbox -> IO (Gtk.CheckMenuItem, IO ())+newItem verbose MkCheckbox {..} = do+ item <- Gtk.checkMenuItemNewWithLabel chLabel++ signalId <- runCommandOnToggle verbose chOnClick item++ pure (item, updateAction item signalId)+ where+ updateAction item signalId = do+ mbOutput <- runCommand verbose chOnGetStatus+ let active = maybe False (not . T.null) mbOutput+ GObject.signalHandlerBlock item signalId+ Gtk.checkMenuItemSetActive item active+ GObject.signalHandlerUnblock item signalId++runCommandOnToggle :: Bool -> Text -> Gtk.CheckMenuItem -> IO CULong+runCommandOnToggle verbose command item =+ Gtk.on item #toggled . void $ runCommand verbose command
+ systranything/Model/Command.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.Command (Command (..), periodicallyUpdateIcon) where++import Control.Monad (void)+import Data.Aeson.TH (deriveJSON)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty.Extra ((!?))+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Word (Word32)+import GHC.Generics (Generic)+import qualified GI.AyatanaAppIndicator3 as AI+import qualified GI.GLib as GLib+import Model.Common (runCommand)+import Model.Internal (options)+import Text.Read (readMaybe)++data Command = MkCommand+ { coOnTimeout :: Text,+ coPoolingInterval :: Word32,+ coIcons :: [Text]+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''Command)++periodicallyUpdateIcon :: Bool -> AI.Indicator -> Text -> Command -> IO ()+periodicallyUpdateIcon verbose indicator icon MkCommand {..} =+ void . GLib.timeoutAddSeconds GLib.PRIORITY_DEFAULT coPoolingInterval $ do+ mbOutput <- runCommand verbose coOnTimeout++ let newIcon = fromMaybe icon $ fromIndex =<< toInt =<< mbOutput++ AI.indicatorSetIconFull indicator newIcon Nothing++ pure True+ where+ fromIndex = (!?) (icon :| coIcons)+ toInt = readMaybe . T.unpack
+ systranything/Model/Common.hs view
@@ -0,0 +1,34 @@+module Model.Common (runCommand) where++import Control.Monad (when)+import Data.ByteString.Lazy as LBS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import System.Exit (ExitCode (..))+import System.Process.Typed (readProcess, shell)++runCommand :: Bool -> Text -> IO (Maybe Text)+runCommand verbose command = do+ when verbose . T.putStrLn $ "Running command: " <> command++ (exitCode, stdoutBS, stderrBS) <- readProcess . shell $ T.unpack command++ let stdoutTxt = T.decodeUtf8Lenient (LBS.toStrict stdoutBS)++ when (exitCode /= ExitSuccess) $ do+ T.putStrLn "Command failed: "+ T.putStrLn command++ when (verbose || exitCode /= ExitSuccess) $ do+ let stderrTxt = T.decodeUtf8Lenient (LBS.toStrict stderrBS)+ T.putStrLn "stdout: "+ T.putStrLn stdoutTxt+ T.putStrLn "stderr: "+ T.putStrLn stderrTxt++ pure $+ if exitCode /= ExitSuccess+ then Nothing+ else Just $ T.stripEnd stdoutTxt
+ systranything/Model/Indicator.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.Indicator (Indicator (..), newIndicator) where++import Control.Monad (void, when)+import Data.Aeson.TH (deriveJSON)+import Data.Foldable (traverse_)+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Text (Text)+import GHC.Generics (Generic)+import qualified GI.AyatanaAppIndicator3 as AI+import qualified GI.Gdk as Gdk+import qualified GI.Gtk as Gtk+import Model.Command (Command, periodicallyUpdateIcon)+import Model.Common (runCommand)+import Model.Internal (options)++data Indicator = MkIndicator+ { inIcon :: Text,+ inCommand :: Maybe Command,+ inOnScrollUp :: Maybe Text,+ inOnScrollDown :: Maybe Text+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''Indicator)++newIndicator :: Bool -> Indicator -> Maybe Gtk.Menu -> IO AI.Indicator+newIndicator verbose indicator@MkIndicator {..} menu = do+ gtkIndicator <-+ AI.indicatorNew+ "systranything"+ inIcon+ AI.IndicatorCategorySystemServices++ -- The indicator beeing not active by default means it is hidden+ AI.indicatorSetStatus gtkIndicator AI.IndicatorStatusActive+ AI.indicatorSetMenu gtkIndicator menu++ traverse_ (periodicallyUpdateIcon False gtkIndicator inIcon) inCommand++ onScrollEvent verbose gtkIndicator indicator++ pure gtkIndicator++onScrollEvent :: Bool -> AI.Indicator -> Indicator -> IO ()+onScrollEvent verbose indicator (MkIndicator {..}) = do+ -- GTK sends one scroll up or down event followed by smooth events. Getting+ -- the actual direction from smooth requires to access the scroll event+ -- itself which doesn't seem possible with the current version of+ -- libayarana-appindicator++ refDirection <- newIORef Gdk.ScrollDirectionDown++ void . Gtk.on indicator #scrollEvent $ \_ direction -> do+ when (direction /= Gdk.ScrollDirectionSmooth) $ do+ writeIORef refDirection direction++ lastDirection <- readIORef refDirection++ traverse_ (runCommand verbose) $+ if lastDirection == Gdk.ScrollDirectionDown+ then inOnScrollDown+ else inOnScrollUp
+ systranything/Model/Internal.hs view
@@ -0,0 +1,13 @@+module Model.Internal (options) where++import Data.Aeson (Options(..), SumEncoding(..), camelTo2, defaultOptions)++options :: Options+options =+ defaultOptions+ { fieldLabelModifier = camelTo2 '-' . drop 2,+ constructorTagModifier = camelTo2 '-' . drop 2,+ omitNothingFields = True,+ sumEncoding = ObjectWithSingleField+ }+
+ systranything/Model/Item.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.Item (Item (..), populate) where++import Control.Monad (void)+import Data.Aeson.TH (deriveJSON)+import Data.Foldable (traverse_)+import Data.List (singleton)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE+import GHC.Generics (Generic)+import qualified GI.Gtk as Gtk+import Model.Checkbox (Checkbox (..))+import qualified Model.Checkbox as Checkbox+import Model.Internal (options)+import Model.Label (Label)+import qualified Model.Label as Label+import Model.RadioGroup (RadioGroup (..))+import qualified Model.RadioGroup as RadioGroup+import {-# SOURCE #-} Model.SubMenu (SubMenu)+import {-# SOURCE #-} qualified Model.SubMenu as SubMenu++data Item+ = MkItemLabel Label+ | MkItemCheckbox Checkbox+ | MkItemRadioGroup RadioGroup+ | MkItemSubMenu SubMenu+ | MkItemSeparator+ deriving stock (Generic, Show)++$(deriveJSON options ''Item)++populate :: Bool -> NonEmpty Item -> IO Gtk.Menu+populate verbose items = do+ menu <- Gtk.menuNew+ updateStateActions <- traverse (initAppendAndShow menu) items+ void . Gtk.on menu #show $ sequence_ updateStateActions+ pure menu+ where+ initAppendAndShow :: Gtk.Menu -> Item -> IO (IO ())+ initAppendAndShow menu item = do+ (menuItems, updateAction) <- newItem verbose item+ traverse_ (appendAndShow menu) menuItems+ pure updateAction++ appendAndShow :: Gtk.Menu -> Gtk.MenuItem -> IO ()+ appendAndShow menu item = do+ Gtk.menuShellAppend menu item+ Gtk.widgetShow item++newItem :: Bool -> Item -> IO ([Gtk.MenuItem], IO ())+newItem verbose (MkItemLabel label) =+ (,mempty) . singleton <$> Label.newItem verbose label+newItem verbose (MkItemCheckbox checkbox) = do+ (item, updateAction) <- Checkbox.newItem verbose checkbox+ menuItems <- Gtk.toMenuItem item+ pure ([menuItems], updateAction)+newItem verbose (MkItemRadioGroup group) = do+ (items, updateAction) <- RadioGroup.newItems verbose group+ menuItems <- traverse Gtk.toMenuItem $ NE.toList items+ pure (menuItems, updateAction)+newItem verbose (MkItemSubMenu submenu) =+ (,mempty) . singleton <$> SubMenu.newItem verbose submenu+newItem _ MkItemSeparator =+ (,mempty) . singleton <$> (Gtk.toMenuItem =<< Gtk.separatorMenuItemNew)
+ systranything/Model/Label.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.Label (Label (..), newItem) where++import Control.Monad (void)+import Data.Aeson.TH (deriveJSON)+import Data.Text (Text)+import GHC.Generics (Generic)+import qualified GI.Gtk as Gtk+import Model.Common (runCommand)+import Model.Internal (options)++data Label = MkLabel+ { laLabel :: Text,+ laOnClick :: Text+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''Label)++newItem :: Bool -> Label -> IO Gtk.MenuItem+newItem verbose MkLabel {..} = do+ item <- Gtk.menuItemNewWithLabel laLabel+ void . Gtk.on item #activate . void $ runCommand verbose laOnClick+ pure item
+ systranything/Model/RadioButton.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.RadioButton (RadioButton (..), newItem) where++import Data.Aeson.TH (deriveJSON)+import Data.Text (Text)+import GHC.Generics (Generic)+import qualified GI.Gtk as Gtk+import Model.Internal (options)++data RadioButton = MkRadioButton+ { raLabel :: Text,+ raOnClick :: Text+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''RadioButton)++newItem :: Text -> RadioButton -> IO Gtk.RadioMenuItem+newItem selected MkRadioButton {..} = do+ menuItem <- Gtk.radioMenuItemNewWithLabel ([] :: [Gtk.RadioMenuItem]) raLabel+ Gtk.checkMenuItemSetActive menuItem (selected == raLabel)+ pure menuItem
+ systranything/Model/RadioGroup.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.RadioGroup (RadioGroup (..), newItems) where++import Control.Monad (void, when)+import Data.Aeson.TH (deriveJSON)+import Data.Foldable (traverse_)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Foreign.C (CULong)+import GHC.Generics (Generic)+import qualified GI.GObject as GI+import qualified GI.Gtk as Gtk+import Model.Common (runCommand)+import Model.Internal (options)+import Model.RadioButton (RadioButton (..))+import qualified Model.RadioButton as RadioButton++data RadioGroup = MkRadioGroup+ { raButtons :: NonEmpty RadioButton,+ raDefault :: Text,+ raOnGetStatus :: Text+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''RadioGroup)++newItems :: Bool -> RadioGroup -> IO (NonEmpty Gtk.RadioMenuItem, IO ())+newItems verbose MkRadioGroup {..} = do+ items@(x :| xs) <- traverse (RadioButton.newItem raDefault) raButtons++ traverse_ (`Gtk.radioMenuItemJoinGroup` Just x) xs++ signalIds <- traverse connectOnToggled $ NE.zip items raButtons++ pure (items, updateAction $ NE.zip items signalIds)+ where+ connectOnToggled (item, MkRadioButton {..}) = do+ checkMenuItem <- Gtk.toCheckMenuItem item+ runCommandOnToggleActive verbose raOnClick checkMenuItem++ updateAction itemsAndSignalIds = do+ mbOutput <- runCommand verbose raOnGetStatus+ let selected = fromMaybe raDefault mbOutput+ traverse_ (updateActive selected) itemsAndSignalIds++ updateActive selected (item, signalId) = do+ label <- Gtk.menuItemGetLabel item+ GI.signalHandlerBlock item signalId+ Gtk.setCheckMenuItemActive item $ label == selected+ GI.signalHandlerUnblock item signalId++runCommandOnToggleActive :: Bool -> Text -> Gtk.CheckMenuItem -> IO CULong+runCommandOnToggleActive verbose command item =+ Gtk.on item #toggled $ do+ isActive <- Gtk.checkMenuItemGetActive item+ when isActive . void $ runCommand verbose command
+ systranything/Model/Root.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.Root (Root (..)) where++import Data.Aeson.TH (deriveJSON)+import Data.List.NonEmpty (NonEmpty)+import GHC.Generics (Generic)+import Model.Indicator (Indicator)+import Model.Internal (options)+import Model.Item (Item)++data Root = MkRoot+ { roIndicator :: Indicator,+ roMenu :: Maybe (NonEmpty Item)+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''Root)
+ systranything/Model/SubMenu.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}++module Model.SubMenu (SubMenu (..), newItem) where++import Data.Aeson.TH (deriveJSON)+import Data.List.NonEmpty (NonEmpty)+import Data.Text (Text)+import GHC.Generics (Generic)+import qualified GI.Gtk as Gtk+import Model.Internal (options)+import Model.Item (Item, populate)++data SubMenu = MkSubMenu+ { suLabel :: Text,+ suItems :: NonEmpty Item+ }+ deriving stock (Generic, Show)++$(deriveJSON options ''SubMenu)++newItem :: Bool -> SubMenu -> IO Gtk.MenuItem+newItem verbose (MkSubMenu {..}) = do+ subMenu <- populate verbose suItems+ item <- Gtk.menuItemNewWithLabel suLabel+ Gtk.menuItemSetSubmenu item $ Just subMenu+ pure item
+ systranything/Model/SubMenu.hs-boot view
@@ -0,0 +1,14 @@+module Model.SubMenu where++import Data.Aeson (FromJSON, ToJSON)+import qualified GI.Gtk as Gtk++data SubMenu++instance Show SubMenu++instance FromJSON SubMenu++instance ToJSON SubMenu++newItem :: Bool -> SubMenu -> IO Gtk.MenuItem
+ systranything/Options.hs view
@@ -0,0 +1,40 @@+module Options (Options (..), parseArgs) where++import Control.Applicative ((<**>))+import Options.Applicative+ ( Parser,+ execParser,+ fullDesc,+ help,+ helper,+ info,+ long,+ metavar,+ short,+ strOption,+ switch,+ )++data Options = MkOptions+ { opVerbose :: Bool,+ opFilename :: FilePath+ }+ deriving (Show)++parseArgs :: IO Options+parseArgs = execParser (info (parser <**> helper) fullDesc)++parser :: Parser Options+parser =+ MkOptions+ <$> switch+ ( long "verbose"+ <> short 'v'+ <> help "Enable verbose mode"+ )+ <*> strOption+ ( long "filename"+ <> short 'f'+ <> metavar "FILENAME"+ <> help "Path to the configuration file"+ )