FIX pinentry bug

ADD lots of little files that were scattered around
ENH revert failed last two commits
2024-03-13 21:58:28 -04:00 · 2024-01-07 11:50:22 -05:00 · 2024-01-07 11:49:30 -05:00 · 2023-02-22 23:02:04 -05:00 · 2023-02-22 22:44:44 -05:00 · 2023-02-16 22:53:00 -05:00
27 changed files with 1441 additions and 1491 deletions
--- a/.stylish-haskell.yaml
+++ b/.stylish-haskell.yaml
@ -1,357 +0,0 @@
-# stylish-haskell configuration file
-# ==================================
-
-# The stylish-haskell tool is mainly configured by specifying steps. These steps
-# are a list, so they have an order, and one specific step may appear more than
-# once (if needed). Each file is processed by these steps in the given order.
-steps:
-  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
-  # by default.
-  # - unicode_syntax:
-  #     # In order to make this work, we also need to insert the UnicodeSyntax
-  #     # language pragma. If this flag is set to true, we insert it when it's
-  #     # not already present. You may want to disable it if you configure
-  #     # language extensions using some other method than pragmas. Default:
-  #     # true.
-  #     add_language_pragma: true
-
-  # Format module header
-  #
-  # Currently, this option is not configurable and will format all exports and
-  # module declarations to minimize diffs
-  #
-  # - module_header:
-  #     # How many spaces use for indentation in the module header.
-  #     indent: 4
-  #
-  #     # Should export lists be sorted?  Sorting is only performed within the
-  #     # export section, as delineated by Haddock comments.
-  #     sort: true
-  #
-  #     # See `separate_lists` for the `imports` step.
-  #     separate_lists: true
-
-  # Format record definitions. This is disabled by default.
-  #
-  # You can control the layout of record fields. The only rules that can't be configured
-  # are these:
-  #
-  # - "|" is always aligned with "="
-  # - "," in fields is always aligned with "{"
-  # - "}" is likewise always aligned with "{"
-  #
-  # - records:
-  #     # How to format equals sign between type constructor and data constructor.
-  #     # Possible values:
-  #     # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the next line.
-  #     equals: "indent 2"
-  #
-  #     # How to format first field of each record constructor.
-  #     # Possible values:
-  #     # - "same_line" -- "{" and first field goes on the same line as the data constructor.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor
-  #     first_field: "indent 2"
-  #
-  #     # How many spaces to insert between the column with "," and the beginning of the comment in the next line.
-  #     field_comment: 2
-  #
-  #     # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.
-  #     deriving: 2
-  #
-  #     # How many spaces to insert before "via" clause counted from indentation of deriving clause
-  #     # Possible values:
-  #     # - "same_line" -- "via" part goes on the same line as "deriving" keyword.
-  #     # - "indent N" -- insert a new line and N spaces from the beginning of "deriving" keyword.
-  #     via: "indent 2"
-  #
-  #     # Sort typeclass names in the "deriving" list alphabetically.
-  #     sort_deriving: true
-  #
-  #     # Wheter or not to break enums onto several lines
-  #     #
-  #     # Default: false
-  #     break_enums: false
-  #
-  #     # Whether or not to break single constructor data types before `=` sign
-  #     #
-  #     # Default: true
-  #     break_single_constructors: true
-  #
-  #     # Whether or not to curry constraints on function.
-  #     #
-  #     # E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
-  #     #
-  #     # Instead of @allValues :: (Enum a, Bounded a) => Proxy a -> [a]@
-  #     #
-  #     # Default: false
-  #     curried_context: false
-
-  # Align the right hand side of some elements.  This is quite conservative
-  # and only applies to statements where each element occupies a single
-  # line.
-  # Possible values:
-  # - always - Always align statements.
-  # - adjacent - Align statements that are on adjacent lines in groups.
-  # - never - Never align statements.
-  # All default to always.
-  - simple_align:
-      cases: always
-      top_level_patterns: always
-      records: always
-      multi_way_if: always
-
-  # Import cleanup
-  - imports:
-      # There are different ways we can align names and lists.
-      #
-      # - global: Align the import names and import list throughout the entire
-      #   file.
-      #
-      # - file: Like global, but don't add padding when there are no qualified
-      #   imports in the file.
-      #
-      # - group: Only align the imports per group (a group is formed by adjacent
-      #   import lines).
-      #
-      # - none: Do not perform any alignment.
-      #
-      # Default: global.
-      align: global
-
-      # The following options affect only import list alignment.
-      #
-      # List align has following options:
-      #
-      # - after_alias: Import list is aligned with end of import including
-      #   'as' and 'hiding' keywords.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                          init, last, length)
-      #
-      # - with_alias: Import list is aligned with start of alias or hiding.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                 init, last, length)
-      #
-      # - with_module_name: Import list is aligned `list_padding` spaces after
-      #   the module name.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #                          init, last, length)
-      #
-      #   This is mainly intended for use with `pad_module_names: false`.
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, head,
-      #                          init, last, length, scanl, scanr, take, drop,
-      #                          sort, nub)
-      #
-      # - new_line: Import list starts always on new line.
-      #
-      #   > import qualified Data.List      as List
-      #   >     (concat, foldl, foldr, head, init, last, length)
-      #
-      # - repeat: Repeat the module name to align the import list.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head)
-      #   > import qualified Data.List      as List (init, last, length)
-      #
-      # Default: after_alias
-      list_align: after_alias
-
-      # Right-pad the module names to align imports in a group:
-      #
-      # - true: a little more readable
-      #
-      #   > import qualified Data.List       as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # - false: diff-safe
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, init,
-      #   >                                     last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # Default: true
-      pad_module_names: true
-
-      # Long list align style takes effect when import is too long. This is
-      # determined by 'columns' setting.
-      #
-      # - inline: This option will put as much specs on same line as possible.
-      #
-      # - new_line: Import list will start on new line.
-      #
-      # - new_line_multiline: Import list will start on new line when it's
-      #   short enough to fit to single line. Otherwise it'll be multiline.
-      #
-      # - multiline: One line per import list entry.
-      #   Type with constructor list acts like single import.
-      #
-      #   > import qualified Data.Map as M
-      #   >     ( empty
-      #   >     , singleton
-      #   >     , ...
-      #   >     , delete
-      #   >     )
-      #
-      # Default: inline
-      long_list_align: multiline
-
-      # Align empty list (importing instances)
-      #
-      # Empty list align has following options
-      #
-      # - inherit: inherit list_align setting
-      #
-      # - right_after: () is right after the module name:
-      #
-      #   > import Vector.Instances ()
-      #
-      # Default: inherit
-      empty_list_align: inherit
-
-      # List padding determines indentation of import list on lines after import.
-      # This option affects 'long_list_align'.
-      #
-      # - <integer>: constant value
-      #
-      # - module_name: align under start of module name.
-      #   Useful for 'file' and 'group' align settings.
-      #
-      # Default: 4
-      list_padding: 4
-
-      # Separate lists option affects formatting of import list for type
-      # or class. The only difference is single space between type and list
-      # of constructors, selectors and class functions.
-      #
-      # - true: There is single space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
-      #
-      # - false: There is no space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
-      #
-      # Default: true
-      separate_lists: true
-
-      # Space surround option affects formatting of import lists on a single
-      # line. The only difference is single space after the initial
-      # parenthesis and a single space before the terminal parenthesis.
-      #
-      # - true: There is single space associated with the enclosing
-      #   parenthesis.
-      #
-      #   > import Data.Foo ( foo )
-      #
-      # - false: There is no space associated with the enclosing parenthesis
-      #
-      #   > import Data.Foo (foo)
-      #
-      # Default: false
-      space_surround: false
-
-      # Enabling this argument will use the new GHC lib parse to format imports.
-      #
-      # This currently assumes a few things, it will assume that you want post
-      # qualified imports. It is also not as feature complete as the old
-      # imports formatting.
-      #
-      # It does not remove redundant lines or merge lines. As such, the full
-      # feature scope is still pending.
-      #
-      # It _is_ however, a fine alternative if you are using features that are
-      # not parseable by haskell src extensions and you're comfortable with the
-      # presets.
-      #
-      # Default: false
-      ghc_lib_parser: false
-
-  # Language pragmas
-  - language_pragmas:
-      # We can generate different styles of language pragma lists.
-      #
-      # - vertical: Vertical-spaced language pragmas, one per line.
-      #
-      # - compact: A more compact style.
-      #
-      # - compact_line: Similar to compact, but wrap each line with
-      #   `{-#LANGUAGE #-}'.
-      #
-      # Default: vertical.
-      style: vertical
-
-      # Align affects alignment of closing pragma brackets.
-      #
-      # - true: Brackets are aligned in same column.
-      #
-      # - false: Brackets are not aligned together. There is only one space
-      #   between actual import and closing bracket.
-      #
-      # Default: true
-      align: true
-
-      # stylish-haskell can detect redundancy of some language pragmas. If this
-      # is set to true, it will remove those redundant pragmas. Default: true.
-      remove_redundant: true
-
-      # Language prefix to be used for pragma declaration, this allows you to
-      # use other options non case-sensitive like "language" or "Language".
-      # If a non correct String is provided, it will default to: LANGUAGE.
-      language_prefix: LANGUAGE
-
-  # Replace tabs by spaces. This is disabled by default.
-  # - tabs:
-  #     # Number of spaces to use for each tab. Default: 8, as specified by the
-  #     # Haskell report.
-  #     spaces: 8
-
-  # Remove trailing whitespace
-  - trailing_whitespace: {}
-
-  # Squash multiple spaces between the left and right hand sides of some
-  # elements into single spaces. Basically, this undoes the effect of
-  # simple_align but is a bit less conservative.
-  # - squash: {}
-
-# A common setting is the number of columns (parts of) code will be wrapped
-# to. Different steps take this into account.
-#
-# Set this to null to disable all line wrapping.
-#
-# Default: 80.
-columns: 80
-
-# By default, line endings are converted according to the OS. You can override
-# preferred format here.
-#
-# - native: Native newline format. CRLF on Windows, LF on other OSes.
-#
-# - lf: Convert to LF ("\n").
-#
-# - crlf: Convert to CRLF ("\r\n").
-#
-# Default: native.
-newline: native
-
-# Sometimes, language extensions are specified in a cabal file or from the
-# command line instead of using language pragmas in the file. stylish-haskell
-# needs to be aware of these, so it can parse the file correctly.
-#
-# No language extensions are enabled by default.
-# language_extensions:
-  # - TemplateHaskell
-  # - QuasiQuotes
-
-# Attempt to find the cabal file in ancestors of the current directory, and
-# parse options (currently only language extensions) from that.
-#
-# Default: true
-cabal: true
--- a/README.md
+++ b/README.md
@ -3,7 +3,42 @@
 These are some personal programs that use the
 [rofi](https://github.com/davatorium/rofi) interface.

-## Rofi-Bitwarden
+## Installation
+
+Clone this repo and run the following in the repo root.
+
+Install packages needed for building:
+
+```
+pacman -S --needed - < make_pkgs
+```
+
+Build and install (choose individual targets as needed):
+
+```
+stack install
+```
+
+See individual sections for other dependencies to install.
+
+## Putting Rofi on the correct screen (rofi)
+
+This is a total hack...actually it isn't because it's written in Haskell and not
+bash.
+
+The problem is that when used with xmonad, rofi doesn't place itself on the
+"current" workspace since the concept of a "workspace" is weird and specific to
+xmonad. The solution is to use this program to query `_NET_DESKTOP_VIEWPORT`
+(which my xmonad config sets) and use this determine the name of the active
+workspace which can then be fed to rofi using the `-m` flag.
+
+See comments of this binary for details.
+
+### Dependencies
+
+- X11
+
+## Bitwarden (rofi-bw)

 [Bitwarden](https://bitwarden.com/) is an open-source password management server
 and this program functions as a client. Unlike many other similar clients, this
@ -37,10 +72,9 @@ Any options after `-c` will be passed to rofi.

 ### Dependencies
 - [bitwarden-cli](https://github.com/bitwarden/cli)
- dbus
 - libnotify: desktop notifications

-## Rofi-Devices
+## Device Mounting (rofi-dev)

 This is a manual mounting helper for removable drives, MTP devices, and fstab
 entries. It will transparently handle mountpoint creation/destruction.
@ -75,6 +109,19 @@ To specifify that `/media/USER/foo` should use `secret-tool` to find its
 password, specify the `-s` option. This would lookup a password for the entry
 whose `username` is `bar` and `hostname` is `example.com`:

+### Veracrypt
+
+This tool can mount veracrypt vaults...with some hacky effort. Since veracrypt
+works at the block device level, it needs root permissions to mount a volume
+(which actually involves mounting several devices). The easiest way to make sure
+this works is to give veracrypt sudo access like so:
+
+```
+<user> ALL=(root) NOPASSWD: /usr/bin/veracrypt,/usr/bin/uptime
+```
+
+No idea why `uptime` is also needed for this.
+
 ``` sh
 rofi-dev -s '/media/USER/foo:username=bar,hostname=example.com'
 ```
@ -89,6 +136,58 @@ rofi-dev -p '/media/USER/foo'
 - udisks2: removable drive mounting
 - sshfs: mounting network devices in fstab over ssh
 - cifs-utils: mounting network devices in fstab using CIFS/Samba
+- veracrypt: to mount veracrypt vaults
 - [jmtpfs](https://github.com/JasonFerrara/jmtpfs): mounting MTP devices
 - libnotify: desktop notifications
 - libsecret: password lookup with `secret-tool`
+
+## Autorandr (rofi-autorandr)
+
+This allows selection of the
+[autorandr](https://github.com/phillipberndt/autorandr) configuration via a rofi
+menu.
+
+### Dependencies
+
+- autorandr
+
+## Bluetooth (rofi-bw)
+
+This presents a nice menu to select the current bluetooth device.
+
+### Dependencies
+
+- bluez (which should provide the dbus interface for this to work)
+
+## ExpressVPN (rofi-evpn)
+
+This presents a menu to select the current ExpressVPN gateway.
+
+### Dependencies
+
+- expressvpn (from AUR)
+- libnotify
+
+## Pinentry (pinentry-rofi)
+
+Analogous to the default [pinentry](https://github.com/gpg/pinentry) prompts,
+this presents a rofi prompt for a password with the GPG keyring is unlocked.
+
+Requires the following in `gpg-agent.conf`:
+
+```
+pinentry-program /path/to/pinentry-rofi
+```
+
+Unlike the other pinentry programs, this one can integrate with bitwarden (via
+the above client) by retrieving the password for the gpg keyring if it is stored
+in bitwarden. This requires a yaml configuration in the gpg home directoring as
+such:
+
+```
+bitwarden-name: <name of GPG bitwarden entry>
+```
+
+### Dependencies
+
+- rofi-bw (see above): bitwarden integration
--- a/app/pinentry-rofi.hs
+++ b/app/pinentry-rofi.hs
@ -1,7 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 --------------------------------------------------------------------------------
-- | rofi-pinentry - a simply pinentry proxy for bitwarden
+-- rofi-pinentry - a simply pinentry proxy for bitwarden
 --
 -- Rather than prompt the user like all the other pinentry programs, call the
 -- bitwarden deamon and prompt for a password there
@ -9,57 +7,57 @@
 module Main where

 import Bitwarden.Internal
-
-import           Data.List
+import qualified Data.Text.IO as TI
 import Data.Yaml
-
-import           System.Directory
-import           System.Environment
-import           System.Exit
+import RIO
+import RIO.Directory
+import qualified RIO.List as L
+import qualified RIO.Text as T
 import System.FilePath.Posix
-import           System.IO
 import System.Posix.Process
+import UnliftIO.Environment

 main :: IO ()
-main = do
+main = runSimpleApp $ do
  hSetBuffering stdout LineBuffering
-  putStrLn "OK Pleased to meet you"
+  -- NOTE: can't use RIO logging here since that will do to stderr and not
+  -- stdout
+  putStrLnT "OK Pleased to meet you"
  pinentryLoop =<< readPinConf

-newtype PinConf = PinConf { pcBwName :: String } deriving (Eq, Show)
+newtype PinConf = PinConf {pcBwName :: T.Text} deriving (Eq, Show)

 instance FromJSON PinConf where
  parseJSON (Object o) = PinConf <$> o .:? "bitwarden-name" .!= "gnupg"
  parseJSON _ = fail "pinentry yaml parse error"

-readPinConf :: IO PinConf
+readPinConf :: RIO SimpleApp PinConf
 readPinConf = do
-  c <- decodeFileEither =<< pinConfDir
+  c <- liftIO . decodeFileEither =<< pinConfDir
  case c of
-    Left e  -> print e >> exitWith (ExitFailure 1)
+    Left e -> do
+      logError $ displayShow e
+      exitWith (ExitFailure 1)
    Right r -> return r

-pinConfDir :: IO FilePath
+pinConfDir :: RIO SimpleApp FilePath
 pinConfDir = maybe defHome (return . (</> confname)) =<< lookupEnv "GNUPGHOME"
  where
    defHome = (</> ".gnupg" </> confname) <$> getHomeDirectory
    confname = "pinentry-rofi.yml"

-pinentryLoop :: PinConf -> IO ()
+pinentryLoop :: PinConf -> RIO SimpleApp ()
 pinentryLoop p = do
-  processLine p . words =<< getLine
+  processLine p . T.words =<< liftIO TI.getLine
  pinentryLoop p

-processLine :: PinConf -> [String] -> IO ()
+processLine :: PinConf -> [T.Text] -> RIO SimpleApp ()
 processLine _ [] = noop
 processLine _ ["BYE"] = exitSuccess
 processLine p ["GETPIN"] = getPin p
-
 processLine _ ["GETINFO", o] = processGetInfo o
-
 -- TODO this might be important
 processLine _ ["OPTION", o] = processOption o
-
 -- these should all do nothing
 processLine _ ("SETDESC" : _) = noop
 processLine _ ("SETOK" : _) = noop
@ -67,40 +65,41 @@ processLine _ ("SETNOTOK":_)                 = noop
 processLine _ ("SETCANCEL" : _) = noop
 processLine _ ("SETPROMPT" : _) = noop
 processLine _ ("SETERROR" : _) = noop
-
 -- CONFIRM can take a flag
 processLine _ ["CONFIRM"] = noop
 processLine _ ["CONFIRM", "--one-button", _] = noop
+processLine _ ss = unknownCommand $ T.unwords ss

-processLine _ ss                             = unknownCommand $ unwords ss
+unknownCommand :: T.Text -> RIO SimpleApp ()
+unknownCommand c = putStrLnT $ T.append "ERR 275 Unknown command " c

-unknownCommand :: String -> IO ()
-unknownCommand c = putStrLn $ "ERR 275 Unknown command " ++ c
-
-getPin :: PinConf -> IO ()
+getPin :: PinConf -> RIO SimpleApp ()
 getPin p = do
  its <- getItems
-  let w = (password . login) =<< find (\i -> pcBwName p == name i) its
+  let w = (password . login) =<< L.find (\i -> pcBwName p == name i) its
  maybe err send w
  where
-    err = putStrLn "ERR 83886179 Operation canceled <rofi>"
+    err = putStrLnT "ERR 83886179 Operation canceled <rofi>"

 -- these are the only supported options for GETINFO; anything else is an error
-processGetInfo :: String -> IO ()
-processGetInfo "pid"     = send . show =<< getProcessID
+processGetInfo :: T.Text -> RIO SimpleApp ()
+processGetInfo "pid" = send . T.pack . show =<< liftIO getProcessID
 processGetInfo "version" = noop
 processGetInfo "flavor" = noop
 processGetInfo "ttyinfo" = noop
-processGetInfo _         = putStrLn "ERR 83886360 IPC parameter error <rofi>"
+processGetInfo _ = putStrLnT "ERR 83886360 IPC parameter error <rofi>"

-processOption :: String -> IO ()
+processOption :: T.Text -> RIO SimpleApp ()
 processOption _ = noop

-send :: String -> IO ()
-send s = putStrLn ("D " ++ s) >> ok
+send :: T.Text -> RIO SimpleApp ()
+send s = putStrLnT (T.append "D " s) >> ok

-noop :: IO ()
+noop :: RIO SimpleApp ()
 noop = ok

-ok :: IO ()
-ok = putStrLn "OK"
+ok :: RIO SimpleApp ()
+ok = putStrLnT "OK"
+
+putStrLnT :: MonadIO m => T.Text -> m ()
+putStrLnT = liftIO . TI.putStrLn
--- a/app/rofi-autorandr.hs
+++ b/app/rofi-autorandr.hs
@ -1,65 +1,55 @@
 --------------------------------------------------------------------------------
-- | rofi-autorandr - a rofi prompt to select autorandr profiles
+-- rofi-autorandr - a rofi prompt to select autorandr profiles
 --
 -- Simple wrapper to select an autorandr profile.

-
 module Main (main) where

-import           Control.Monad
-
-import           Data.Maybe
-
+import RIO
+import RIO.Directory
+import qualified RIO.Text as T
 import Rofi.Command
-
-import           System.Directory
-import           System.Environment
-import           System.Exit
+import Rofi.IO
 import System.FilePath.Posix
 import System.Process
+import UnliftIO.Environment

 main :: IO ()
-main = runChecks >> getArgs >>= runPrompt
+main = runSimpleApp $ do
+  checkExe "autorandr"
+  getArgs >>= runPrompt

-- TOOD not DRY
-runChecks :: IO ()
-runChecks = checkExe "autorandr" >> checkExe "rofi"
+newtype ARClientConf = ARClientConf [T.Text]

-checkExe :: String -> IO ()
-checkExe cmd = do
-  res <- findExecutable cmd
-  unless (isJust res) $ do
-    putStrLn $ "Could not find executable: " ++ cmd
-    exitWith $ ExitFailure 1
-
-newtype ARClientConf = ARClientConf [String]
-
-instance RofiConf ARClientConf where
+instance HasRofiConf ARClientConf where
  defArgs (ARClientConf a) = a

-runPrompt :: [String] -> IO ()
+runPrompt :: MonadIO m => [String] -> m ()
 runPrompt a = do
-  let c = ARClientConf a
+  let c = ARClientConf $ fmap T.pack a
  staticProfs <- getAutoRandrProfiles
-  runRofiIO c $ selectAction $ emptyMenu
+  runRofi c $
+    emptyMenu
      { groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
      , prompt = Just "Select Profile"
      }
  where
-    mkGroup header = titledGroup header . toRofiActions
-      . fmap (\s -> ("  " ++ s, selectProfile s))
+    mkGroup header =
+      titledGroup header
+        . toRofiActions
+        . fmap (\s -> (T.append "  " s, selectProfile s))

-virtProfs :: [String]
+virtProfs :: [T.Text]
 virtProfs = ["off", "common", "clone-largest", "horizontal", "vertical"]

 -- TODO filter profiles based on which xrandr outputs are actually connected
-getAutoRandrProfiles :: IO [String]
+getAutoRandrProfiles :: MonadIO m => m [T.Text]
 getAutoRandrProfiles = do
  dir <- getAutoRandrDir
  contents <- listDirectory dir
-  filterM (doesDirectoryExist . (dir </>)) contents
+  (fmap T.pack) <$> filterM (doesDirectoryExist . (dir </>)) contents

-getAutoRandrDir :: IO String
+getAutoRandrDir :: MonadIO m => m FilePath
 getAutoRandrDir = do
  c <- getXdgDirectory XdgConfig "autorandr"
  e <- doesDirectoryExist c
@ -67,7 +57,8 @@ getAutoRandrDir = do
  where
    appendToHome p = (</> p) <$> getHomeDirectory

-selectProfile :: String -> RofiIO ARClientConf ()
-selectProfile name = do
-  io $ putStrLn name
-  io $ void $ spawnProcess "autorandr" ["--change", name]
+selectProfile :: T.Text -> RIO ARClientConf ()
+selectProfile name =
+  liftIO $
+    void $
+      spawnProcess "autorandr" ["--change", T.unpack name]
--- a/app/rofi-bt.hs
+++ b/app/rofi-bt.hs
@ -1,62 +1,67 @@
 --------------------------------------------------------------------------------
-- | rofi-bt - a prompt to dicsonnect/connect devices
+-- rofi-bt - a prompt to dicsonnect/connect devices
 --

 module Main (main) where

-import           Control.Exception
-import           Control.Monad
-import           Control.Monad.Reader
-
-import           Data.List
-import           Data.List.Split
-import qualified Data.Map             as M
-import           Data.Maybe
-
 import DBus
 import DBus.Client
-
+import qualified Data.Map as M
+import Data.Maybe
+import RIO
+import qualified RIO.List as L
+import qualified RIO.Text as T
 import Rofi.Command
-
-import           System.Environment
+import UnliftIO.Environment

 main :: IO ()
-main = getArgs >>= runPrompt
+main = runSimpleApp $ getArgs >>= runPrompt

-data RofiBTConf = RofiBTConf [String] ObjectPath
+data RofiBTConf = RofiBTConf
+  { btArgs :: ![T.Text]
+  , btAdapter :: !ObjectPath
+  , btEnv :: !SimpleApp
+  }

-instance RofiConf RofiBTConf where
-  defArgs (RofiBTConf as _) = as
+instance HasRofiConf RofiBTConf where
+  defArgs = btArgs
+
+instance HasLogFunc RofiBTConf where
+  logFuncL = lens btEnv (\x y -> x {btEnv = y}) . logFuncL

 type BTAction = RofiAction RofiBTConf

-runPrompt :: [String] -> IO ()
+runPrompt :: [String] -> RIO SimpleApp ()
 runPrompt args = do
  c <- getClient
-  maybe (putStrLn "could not get DBus client") run c
+  maybe (logError "could not get DBus client") run c
  where
    run client = do
      paths <- M.keys <$> getObjectTree client
-      maybe (putStrLn "could not get DBus adapter") (actions client paths)
-        $ getAdapter paths
-    actions client paths adapter = do
+      case getAdapter paths of
+        Nothing -> logError "could not get DBus adapter"
+        Just adapter -> do
          ras <- getRofiActions client paths
-      runRofiIO (RofiBTConf args adapter) $ selectAction $ emptyMenu
+          mapRIO (RofiBTConf (fmap T.pack args) adapter) $
+            selectAction $
+              emptyMenu
                { groups = [untitledGroup $ toRofiActions ras]
                , prompt = Just "Select Device"
                }

-getRofiActions :: Client -> [ObjectPath] -> IO [BTAction]
+getRofiActions :: MonadIO m => Client -> [ObjectPath] -> m [BTAction]
 getRofiActions client os = do
  devs <- getDevices client os
  catMaybes <$> mapM (deviceToRofiAction client) devs

-deviceToRofiAction :: Client -> ObjectPath -> IO (Maybe BTAction)
+deviceToRofiAction :: MonadIO m => Client -> ObjectPath -> m (Maybe BTAction)
 deviceToRofiAction client dev = do
  c <- getDeviceConnected client dev
  n <- getDeviceName client dev
  return $ case (c, n) of
-    (Just c', Just n') -> Just ( formatDeviceEntry c' n'
+    (Just c', Just n') ->
+      Just
+        ( formatDeviceEntry c' n'
        , powerAdapterMaybe client >> io (mkAction c')
        )
    _ -> Nothing
@ -64,13 +69,13 @@ deviceToRofiAction client dev = do
    mkAction True = callDeviceDisconnect client dev
    mkAction False = callDeviceConnect client dev

-powerAdapterMaybe :: Client -> RofiIO RofiBTConf ()
+powerAdapterMaybe :: Client -> RIO RofiBTConf ()
 powerAdapterMaybe client = do
-  (RofiBTConf _ adapter) <- ask
+  adapter <- asks btAdapter
  let mc = btMethodCall adapter i m
-  let powerOnMaybe = flip unless $ void $ setProperty client mc value
-  powered <- io $ getBTProperty client adapter i m
-  io $ maybe (putStrLn "could not get adapter powered status") powerOnMaybe powered
+  let powerOnMaybe = flip unless $ void $ liftIO $ setProperty client mc value
+  powered <- getBTProperty client adapter i m
+  maybe (logError "could not get adapter powered status") powerOnMaybe powered
  where
    i = interfaceName_ "org.bluez.Adapter1"
    m = memberName_ "Powered"
@ -78,21 +83,21 @@ powerAdapterMaybe client = do
    -- the 'Set' method
    value = toVariant $ toVariant True

-formatDeviceEntry :: Bool -> String -> String
-formatDeviceEntry connected name = unwords [prefix connected, name]
+formatDeviceEntry :: Bool -> T.Text -> T.Text
+formatDeviceEntry connected name = T.unwords [prefix connected, name]
  where
    prefix True = "#"
    prefix False = " "

 getAdapter :: [ObjectPath] -> Maybe ObjectPath
-getAdapter = find pathIsAdaptor
+getAdapter = L.find pathIsAdaptor

-getDevices :: Client -> [ObjectPath] -> IO [ObjectPath]
+getDevices :: MonadIO m => Client -> [ObjectPath] -> m [ObjectPath]
 getDevices client = filterM (getDevicePaired client) . filter pathIsDevice

-type ObjectTree = M.Map ObjectPath (M.Map String (M.Map String Variant))
+type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))

-getObjectTree :: Client -> IO ObjectTree
+getObjectTree :: MonadIO m => Client -> m ObjectTree
 getObjectTree client =
  fromMaybe M.empty . eitherMaybe from <$> callBTMethod client o i m
  where
@ -101,19 +106,19 @@ getObjectTree client =
    m = memberName_ "GetManagedObjects"
    from = fromVariant <=< listToMaybe . methodReturnBody

-getDeviceConnected :: Client -> ObjectPath -> IO (Maybe Bool)
+getDeviceConnected :: MonadIO m => Client -> ObjectPath -> m (Maybe Bool)
 getDeviceConnected = getDevProperty "Connected"

-getDeviceName :: Client -> ObjectPath -> IO (Maybe String)
+getDeviceName :: MonadIO m => Client -> ObjectPath -> m (Maybe T.Text)
 getDeviceName = getDevProperty "Name"

-getDevicePaired :: Client -> ObjectPath -> IO Bool
+getDevicePaired :: MonadIO m => Client -> ObjectPath -> m Bool
 getDevicePaired c = fmap (fromMaybe False) . getDevProperty "Paired" c

-callDeviceConnect :: Client -> ObjectPath -> IO ()
+callDeviceConnect :: MonadIO m => Client -> ObjectPath -> m ()
 callDeviceConnect = callDevMethod "Connect"

-callDeviceDisconnect :: Client -> ObjectPath -> IO ()
+callDeviceDisconnect :: MonadIO m => Client -> ObjectPath -> m ()
 callDeviceDisconnect = callDevMethod "Disconnect"

 pathIsAdaptor :: ObjectPath -> Bool
@ -126,35 +131,48 @@ pathIsDevice o = case splitPath o of
  [a, b, c, _] -> pathIsAdaptorPrefix a b c
  _ -> False

-pathIsAdaptorPrefix :: String -> String -> String -> Bool
-pathIsAdaptorPrefix a b c = a == "org" && b == "bluez" && "hci" `isPrefixOf` c
+pathIsAdaptorPrefix :: T.Text -> T.Text -> T.Text -> Bool
+pathIsAdaptorPrefix a b c = a == "org" && b == "bluez" && "hci" `T.isPrefixOf` c

-splitPath :: ObjectPath -> [String]
-splitPath =splitOn "/" . dropWhile (=='/') . formatObjectPath
+splitPath :: ObjectPath -> [T.Text]
+splitPath = T.split (== '/') . T.dropWhile (== '/') . T.pack . formatObjectPath

-getClient :: IO (Maybe Client)
-getClient = either warn (return . Just) =<< try connectSystem
+getClient :: (MonadReader c m, HasLogFunc c, MonadUnliftIO m) => m (Maybe Client)
+getClient = either warn (return . Just) =<< try (liftIO connectSystem)
  where
-    warn e = putStrLn (clientErrorMessage e) >> return Nothing
+    warn e = do
+      logWarn $ displayBytesUtf8 $ encodeUtf8 $ (T.pack $ clientErrorMessage e)
+      return Nothing

-callDevMethod :: String -> Client -> ObjectPath -> IO ()
+callDevMethod :: MonadIO m => T.Text -> Client -> ObjectPath -> m ()
 callDevMethod mem client dev =
-  void $ callBTMethod client dev btDevInterface $ memberName_ mem
+  void $ callBTMethod client dev btDevInterface $ memberName_ $ T.unpack mem

-getDevProperty :: IsVariant a => String -> Client -> ObjectPath -> IO (Maybe a)
+getDevProperty :: (MonadIO m, IsVariant a) => T.Text -> Client -> ObjectPath -> m (Maybe a)
 getDevProperty mem client dev =
-  getBTProperty client dev btDevInterface $ memberName_ mem
+  getBTProperty client dev btDevInterface $ memberName_ $ T.unpack mem
+
+callBTMethod
+  :: MonadIO m
+  => Client
+  -> ObjectPath
+  -> InterfaceName
+  -> MemberName
+  -> m (Either MethodError MethodReturn)
+callBTMethod client o i m = liftIO $ call client (btMethodCall o i m)

-callBTMethod :: Client -> ObjectPath -> InterfaceName
-  -> MemberName -> IO (Either MethodError MethodReturn)
-callBTMethod client o i m = call client (btMethodCall o i m)
 -- eitherMaybe (fromVariant <=< listToMaybe . methodReturnBody)
 -- <$> call client (btMethodCall o i m)

-getBTProperty :: IsVariant a => Client -> ObjectPath
-  -> InterfaceName -> MemberName -> IO (Maybe a)
+getBTProperty
+  :: (MonadIO m, IsVariant a)
+  => Client
+  -> ObjectPath
+  -> InterfaceName
+  -> MemberName
+  -> m (Maybe a)
 getBTProperty client o i m =
-  eitherMaybe fromVariant <$> getProperty client (btMethodCall o i m)
+  eitherMaybe fromVariant <$> (liftIO $ getProperty client (btMethodCall o i m))

 btMethodCall :: ObjectPath -> InterfaceName -> MemberName -> MethodCall
 btMethodCall o i m = (methodCall o i m) {methodCallDestination = Just btBus}
--- a/app/rofi-bw.hs
+++ b/app/rofi-bw.hs
@ -1,7 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 --------------------------------------------------------------------------------
-- | rofi-bw - a rofi prompt for a bitwarden vault
+-- rofi-bw - a rofi prompt for a bitwarden vault
 --
 -- This is basically a wrapper around the 'bw' command, which is assumed to be
 -- properly configured before running this command. This shows a system of
@ -19,40 +17,29 @@
 module Main (main) where

 import Bitwarden.Internal
-
-import           Control.Monad
-
-import           Data.Maybe
-
-import           Rofi.Command
-
-import           Text.Read
-
-import           System.Directory
-import           System.Environment
-import           System.Exit
+import RIO
+import qualified RIO.Text as T
+import Rofi.IO
+import UnliftIO.Environment

 main :: IO ()
-main = runChecks >> getArgs >>= parse
+main = runSimpleApp $ runChecks >> getArgs >>= parse

 -- TODO check if daemon is running when running client
-parse :: [String] -> IO ()
-parse ["-d", t] = case readMaybe t of { Just t' -> runDaemon t'; _ -> usage }
-parse ("-c":args) = runClient args
+parse :: HasLogFunc c => [String] -> RIO c ()
+parse ["-d", t] = case readMaybe t of Just t' -> runDaemon t'; _ -> usage
+parse ("-c" : args) = runClient $ fmap T.pack args
 parse _ = usage

-usage :: IO ()
-usage = putStrLn $ joinNewline
+usage :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => m ()
+usage =
+  logInfo $
+    displayBytesUtf8 $
+      encodeUtf8 $
+        T.unlines
          [ "daemon mode: rofi-bw -d TIMEOUT"
          , "client mode: rofi-bw -c [ROFI-ARGS]"
          ]

-runChecks :: IO ()
-runChecks = checkExe "bw" >> checkExe "rofi"
-
-checkExe :: String -> IO ()
-checkExe cmd = do
-  res <- findExecutable cmd
-  unless (isJust res) $ do
-    putStrLn $ "Could not find executable: " ++ cmd
-    exitWith $ ExitFailure 1
+runChecks :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => m ()
+runChecks = checkExe "bw"
--- a/app/rofi-dev.hs
+++ b/app/rofi-dev.hs
--- a/app/rofi-evpn.hs
+++ b/app/rofi-evpn.hs
@ -1,24 +1,19 @@
 --------------------------------------------------------------------------------
-- | rofi-evpn - a prompt to dicsonnect/connect with express VPN
+-- rofi-evpn - a prompt to dicsonnect/connect with express VPN
 --

 module Main (main) where

-import           Control.Monad
-
-import           Data.List          (isPrefixOf)
-import           Data.List.Split
-import           Data.Maybe
-
+import RIO
+import qualified RIO.Text as T
 import Rofi.Command
-
-import           System.Environment
-import           System.Process
+import Rofi.IO
+import UnliftIO.Environment

 main :: IO ()
-main = getArgs >>= runPrompt
+main = runSimpleApp $ getArgs >>= runPrompt

-runPrompt :: [String] -> IO ()
+runPrompt :: [String] -> RIO SimpleApp ()
 runPrompt args = do
  servers <- getServers
  maybe (return ()) run servers
@ -26,7 +21,8 @@ runPrompt args = do
    run (VPNStatus connected servers) = do
      let d = getDisconnectAction <$> connected
      let cs = fmap (getConnectAction connected) servers
-      runRofiIO (RofiVPNConf args) $ selectAction $ emptyMenu
+      runRofi (RofiVPNConf $ fmap T.pack args) $
+        emptyMenu
          { groups =
              [ untitledGroup $ toRofiActions $ maybeToList d
              , untitledGroup $ toRofiActions cs
@ -34,54 +30,56 @@ runPrompt args = do
          , prompt = Just "Select Action"
          }

-newtype RofiVPNConf = RofiVPNConf [String]
+newtype RofiVPNConf = RofiVPNConf [T.Text]

-instance RofiConf RofiVPNConf where
+instance HasRofiConf RofiVPNConf where
  defArgs (RofiVPNConf as) = as

 type VPNAction = RofiAction RofiVPNConf

-type VPNServer = (String, String)
+type VPNServer = (T.Text, T.Text)

-data VPNStatus = VPNStatus (Maybe String) [VPNServer] deriving (Show)
+data VPNStatus = VPNStatus (Maybe T.Text) [VPNServer] deriving (Show)

-getServers :: IO (Maybe VPNStatus)
+getServers :: MonadIO m => m (Maybe VPNStatus)
 getServers = do
  running <- daemonIsRunning
  if running
    then Just <$> getStatus
-    else notify IconError "ExpressVPN daemon not running" >> return Nothing
+    else notifyEVPN IconError "ExpressVPN daemon not running" >> return Nothing

-getStatus :: IO VPNStatus
+getStatus :: MonadIO m => m VPNStatus
 getStatus = do
  connected <- getConnectedServer
  VPNStatus connected <$> getAvailableServers

-getConnectedServer :: IO (Maybe String)
+getConnectedServer :: MonadIO m => m (Maybe T.Text)
 getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] ""
  where
-    procStatus = listToMaybe . mapMaybe procLine . lines
-    procLine l = case words l of
+    procStatus = listToMaybe . mapMaybe procLine . T.lines
+    procLine l = case T.words l of
      -- the output is green...
-      ("\ESC[1;32;49mConnected":"to":server) -> Just $ unwords server
+      ("\ESC[1;32;49mConnected" : "to" : server) -> Just $ T.unwords server
      _ -> Nothing

-getAvailableServers :: IO [VPNServer]
+getAvailableServers :: MonadIO m => m [VPNServer]
 getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
  where
    procOut Nothing = do
-      notify IconError "failed to get list of servers"
+      notifyEVPN IconError "failed to get list of servers"
      return []
    -- ASSUME the output has a useless header that ends in a line that starts
    -- with "-----", after which is the stuff we care about, which is followed
    -- by a blank line, after which there is more stuff I don't care about
-    procOut (Just ls) = return
-      $ mapMaybe (matchLine . splitOn "\t")
-      $ takeWhile (/= "")
-      $ drop 1
+    procOut (Just ls) =
+      return $
+        mapMaybe (matchLine . T.split (== '\t')) $
+          takeWhile (/= "") $
+            drop 1
            -- super lame way of matching lines that start with "-----"
-      $ dropWhile (not . isPrefixOf "-----")
-      $ lines ls
+            $
+              dropWhile (not . T.isPrefixOf "-----") $
+                T.lines ls
    -- The output of this command is very strange; it is delimited (kinda) by
    -- tabs but some lines are long enough that they don't have a tab. In
    -- whatever case, splitting by tabs leads to variable length lists, and the
@ -92,14 +90,14 @@ getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
    matchLine [i, _, _, _, l] = Just (i, l)
    matchLine _ = Nothing

-daemonIsRunning :: IO Bool
+daemonIsRunning :: MonadIO m => m Bool
 daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] ""

-getDisconnectAction :: String -> VPNAction
+getDisconnectAction :: T.Text -> VPNAction
 getDisconnectAction server =
-  ("Disconnect from " ++ server, io $ void $ disconnect server)
+  (T.append "Disconnect from " server, io $ void $ disconnect server)

-getConnectAction :: Maybe String -> VPNServer -> VPNAction
+getConnectAction :: Maybe T.Text -> VPNServer -> VPNAction
 getConnectAction connected server =
  (formatServerLine server, io $ go connected)
  where
@ -109,46 +107,40 @@ getConnectAction connected server =
    go _ = con
    con = connect server

-formatServerLine :: VPNServer -> String
-formatServerLine (sid, sname) = pad sid ++ " | " ++ sname
+formatServerLine :: VPNServer -> T.Text
+formatServerLine (sid, sname) = T.concat [pad sid, " | ", sname]
  where
-    pad s = s ++ replicate (10 - length s) ' '
+    pad s = T.append s $ T.replicate (10 - T.length s) " "

-eVPN :: String
+eVPN :: T.Text
 eVPN = "expressvpn"

-eVPND :: String
+eVPND :: T.Text
 eVPND = "expressvpnd"

-connect :: VPNServer -> IO ()
+connect :: MonadIO m => VPNServer -> m ()
 connect (sid, sname) = do
  res <- readCmdSuccess' eVPN ["connect", sid]
-  notifyIf res ("connected to " ++ sname)
-    ("failed to connect to " ++ sname)
+  notifyIf
+    res
+    (T.append "connected to " sname)
+    (T.append "failed to connect to " sname)

-disconnect :: String -> IO Bool
+disconnect :: MonadIO m => T.Text -> m Bool
 disconnect server = do
  res <- readCmdSuccess' eVPN ["disconnect"]
-  notifyIf res ("disconnected from " ++ server)
-    ("failed to disconnect from " ++ server)
+  notifyIf
+    res
+    (T.append "disconnected from " server)
+    (T.append "failed to disconnect from " server)
  return res

-readCmdSuccess' :: String -> [String] -> IO Bool
+readCmdSuccess' :: MonadIO m => T.Text -> [T.Text] -> m Bool
 readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args ""

-- TODO not DRY
-data NotifyIcon = IconError | IconInfo
+notifyIf :: MonadIO m => Bool -> T.Text -> T.Text -> m ()
+notifyIf True s _ = notifyEVPN IconInfo s
+notifyIf False _ s = notifyEVPN IconError s

-instance Show NotifyIcon where
-  show IconError = "dialog-error-symbolic"
-  show IconInfo  = "dialog-information-symbolic"
-
-notifyIf :: Bool -> String -> String -> IO ()
-notifyIf True s _  = notify IconInfo s
-notifyIf False _ s = notify IconError s
-
-notify :: NotifyIcon -> String -> IO ()
-notify icon body = void $ spawnProcess "notify-send" $ args ++ [body]
-  where
-    args = ["-i", show icon, summary]
-    summary = "ExpressVPN"
+notifyEVPN :: MonadIO m => NotifyIcon -> T.Text -> m ()
+notifyEVPN icon = notify icon "ExpressVPN" . Just
--- a/app/current-output.hs
+++ b/app/current-output.hs
@ -1,14 +1,12 @@
-module Main (main) where
-
 --------------------------------------------------------------------------------
-- | Return current xrandr output name
+-- Run rofi (and display on the correct screen)
 --
 -- Since this seems random, the reason for this is that I want rofi to appear
 -- over the current xmonad workspace, and rofi has no concept of what an
 -- xmonad workspace is (not that it is supposed to, xmonad is weird...). Rofi
 -- accepts the name of an xrandr output onto which it should appear, so this
-- script provides a way to determine which xmonad workspace is in focus and
-- provide the name of the output displaying said workspace.
+-- binary determines which xmonad workspace is in focus and calls rofi with the
+-- name of that workspace.
 --
 -- Assumptions: xmonad sets the _NET_DESKTOP_VIEWPORT atom with the positions of
 -- the active workspace (actually an array of the positions of all workspaces
@ -21,24 +19,32 @@ module Main (main) where
 -- 2) Use index from (1) and to get the position of the active workspace from
 --    _NET_DESKTOP_VIEWPORT
 -- 3) Find the name of the xrandr output whose position matches that from (2)
+-- 4) Call rofi with the '-m' flag to override the default monitor placement

-import           Data.Maybe
+module Main (main) where

 import Graphics.X11.Types
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xrandr
-
-import           System.Exit
+import RIO hiding (Display)
+import RIO.Process
+import qualified RIO.Text as T
+import UnliftIO.Environment

 main :: IO ()
-main = getMonitorName >>= maybe exitFailure (\n -> putStrLn n >> exitSuccess)
+main = runSimpleApp $ do
+  r <- getMonitorName
+  args <- getArgs
+  let allArgs = maybe [] (\n -> ["-m", T.unpack n] ++ args) r
+  c <- proc "/usr/bin/rofi" allArgs runProcess
+  exitWith c

-data Coord = Coord Int Int
-    deriving (Eq, Show)
+data Coord = Coord Int Int deriving (Eq, Show)

-getMonitorName :: IO (Maybe String)
-getMonitorName = do
+-- TODO bracket this
+getMonitorName :: MonadIO m => m (Maybe T.Text)
+getMonitorName = liftIO $ do
  dpy <- openDisplay ""
  root <- rootWindow dpy $ defaultScreen dpy
  index <- getCurrentDesktopIndex dpy root
@ -55,39 +61,39 @@ getDesktopViewports dpy root =
  pairs <$> getAtom32 dpy root "_NET_DESKTOP_VIEWPORT"
  where
    pairs = reverse . pairs' []
-    pairs' acc []         = acc
-    pairs' acc [_]        = acc
    pairs' acc (x1 : x2 : xs) = pairs' (Coord x1 x2 : acc) xs
+    pairs' acc _ = acc

-getOutputs :: Display -> Window -> IO [(Coord, String)]
-getOutputs dpy root = xrrGetScreenResourcesCurrent dpy root >>=
-  maybe (return []) resourcesToCells
+getOutputs :: Display -> Window -> IO [(Coord, T.Text)]
+getOutputs dpy root =
+  xrrGetScreenResourcesCurrent dpy root
+    >>= maybe (return []) resourcesToCells
  where
    resourcesToCells r = catMaybes <$> mapM (outputToCell r) (xrr_sr_outputs r)
    outputToCell r o = xrrGetOutputInfo dpy r o >>= infoToCell r
    -- connection: 0 == connected, 1 == disconnected
-    infoToCell r (Just XRROutputInfo { xrr_oi_connection = 0
+    infoToCell
+      r
+      ( Just
+          XRROutputInfo
+            { xrr_oi_connection = 0
            , xrr_oi_name = n
            , xrr_oi_crtc = c
-                                     }) = do
-      cinfo <- xrrGetCrtcInfo dpy r c
-      return $ fmap (\i -> (toCoord i, n)) cinfo
+            }
+        ) = do
+        fmap (\i -> (toCoord i, T.pack n)) <$> xrrGetCrtcInfo dpy r c
    infoToCell _ _ = return Nothing
    toCoord c = Coord (fromIntegral $ xrr_ci_x c) (fromIntegral $ xrr_ci_y c)

 infix 9 !!?
+
 (!!?) :: [a] -> Int -> Maybe a
 (!!?) xs i
  | i < 0 = Nothing
-    | otherwise = go i xs
-  where
-    go :: Int -> [a] -> Maybe a
-    go 0 (x:_)  = Just x
-    go j (_:ys) = go (j - 1) ys
-    go _ []     = Nothing
+  | otherwise = listToMaybe $ drop i xs

-getAtom32 :: Display -> Window -> String -> IO [Int]
+getAtom32 :: Display -> Window -> T.Text -> IO [Int]
 getAtom32 dpy root str = do
-  a <- internAtom dpy str False
+  a <- internAtom dpy (T.unpack str) False
  p <- getWindowProperty32 dpy a root
  return $ maybe [] (fmap fromIntegral) p
--- a/dhall/rofi-dev.dhall
+++ b/dhall/rofi-dev.dhall
@ -0,0 +1,66 @@
+let MountConfig = { mpPath : Text, mpLabel : Optional Text }
+
+let BitwardenConfig = { bwKey : Text, bwTries : Natural }
+
+let SecretMap = { sKey : Text, sVal : Text }
+
+let SecretConfig = { secretAttributes : List SecretMap }
+
+let PromptConfig = { promptTries : Natural }
+
+let PasswordConfig =
+      < PwdBW : BitwardenConfig | PwdLS : SecretConfig | PwdPr : PromptConfig >
+
+let SSHFSData = { sshfsRemote : Text, sshfsPassword : Optional PasswordConfig }
+
+let CIFSOpts =
+      { cifsoptsUsername : Optional Text
+      , cifsoptsWorkgroup : Optional Text
+      , cifsoptsUID : Optional Natural
+      , cifsoptsGID : Optional Natural
+      , cifsoptsIocharset : Optional Text
+      }
+
+let CIFSData =
+      { cifsRemote : Text
+      , cifsSudo : Bool
+      , cifsPassword : Optional PasswordConfig
+      , cifsOpts : Optional CIFSOpts
+      }
+
+let VeracryptData = { vcVolume : Text, vcPassword : Optional PasswordConfig }
+
+let DataConfig =
+      < VeracryptConfig : VeracryptData
+      | SSHFSConfig : SSHFSData
+      | CIFSConfig : CIFSData
+      >
+
+let DeviceConfig = { deviceMount : MountConfig, deviceData : DataConfig }
+
+let TreeConfig = { tcParent : DeviceConfig, tcChildren : List Text }
+
+let TreeMap = { tKey : Text, tVal : TreeConfig }
+
+let StaticConfig =
+      { scTmpPath : Optional Text
+      , scVerbose : Optional Bool
+      , scDevices : List TreeMap
+      }
+
+in  { StaticConfig
+    , TreeConfig
+    , DeviceConfig
+    , DataConfig
+    , VeracryptData
+    , CIFSData
+    , CIFSOpts
+    , SSHFSData
+    , PasswordConfig
+    , SecretConfig
+    , MountConfig
+    , BitwardenConfig
+    , PromptConfig
+    , TreeMap
+    , SecretMap
+    }
--- a/etc/systemd/user/mount-sshfs@.service
+++ b/etc/systemd/user/mount-sshfs@.service
--- a/etc/systemd/user/mount-veracrypt@.service
+++ b/etc/systemd/user/mount-veracrypt@.service
@ -1,6 +1,7 @@
 [Unit]
 Description=Mount veracrypt volume for %i

+# TODO these scripts moved
 [Service]
 Type=forking
 ExecStart=%h/.bin/mount.veracrypt ${BW_NAME} ${VOLUME} ${MOUNTPOINT}
--- a/fourmolu.yaml
+++ b/fourmolu.yaml
@ -0,0 +1,14 @@
+indentation: 2
+function-arrows: leading
+comma-style: leading
+import-export-style: leading
+indent-wheres: true
+record-brace-space: true
+newlines-between-decls: 1
+haddock-style: single-line
+haddock-style-module:
+let-style: inline
+in-style: right-align
+respectful: false
+fixities: []
+unicode: never
--- a/8
+++ b/8
@ -1,8 +0,0 @@
-#!/bin/bash
-
-# install all dependencies for rofi to run at full capacity
-
-rofi_pkgs=(rofi bitwarden-cli libnotify rofi-greenclip
-           networkmanager-dmenu-git veracrypt sshfs jmtpfs)
-
-yay --needed --noconfirm --norebuild --removemake -S "${rofi_pkgs[@]}"
--- a/lib/Bitwarden/Internal.hs
+++ b/lib/Bitwarden/Internal.hs
@ -1,7 +1,3 @@
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
-
 module Bitwarden.Internal
  ( Item (..)
  , Login (..)
@ -10,27 +6,22 @@ module Bitwarden.Internal
  , runClient
  , getItems
  , callGetSession
-  ) where
-
-import           Control.Concurrent
-import           Control.Monad
-
-import           Data.Aeson
-import           Data.Maybe
-import           Data.String
-import           Data.UnixTime
+  )
+where

 import DBus
 import DBus.Client
-
+import Data.Aeson
+import Data.UnixTime
 import GHC.Generics
-
+import RIO hiding (timeout)
+import qualified RIO.Text as T
 import Rofi.Command
-
 import System.Clipboard
 import System.Process

 --------------------------------------------------------------------------------
+
 -- | Daemon
 --
 -- Daemon will export an interface on DBus with two methods:
@ -39,39 +30,39 @@ import           System.Process
 -- * lock session - destroy the current session id if active
 --
 -- The session ID will be valid only as long as TIMEOUT
-
 newtype BWServerConf = BWServerConf
  { timeout :: UnixDiffTime
  }

 -- TODO add a cache so the browse list will load faster
 data CurrentSession = CurrentSession
-    { timestamp :: UnixTime
-    , hash      :: String
+  { timestamp :: !UnixTime
+  , hash :: !T.Text
  }

 type Session = MVar (Maybe CurrentSession)

-runDaemon :: Int -> IO ()
+runDaemon :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => Int -> m ()
 runDaemon t = do
  ses <- newMVar Nothing
  let c = BWServerConf {timeout = UnixDiffTime (fromIntegral t) 0}
  startService c ses
  forever $ threadDelay 1000000

-lockSession :: Session -> IO ()
+lockSession :: MonadIO m => Session -> m ()
 lockSession ses = void $ swapMVar ses Nothing

-syncSession :: BWServerConf -> Session -> IO ()
+syncSession :: MonadUnliftIO m => BWServerConf -> Session -> m ()
 syncSession conf ses = notify =<< fmap join . mapM cmd =<< getSession' conf ses
  where
    cmd h = readCmdSuccess "bw" ["sync", "--session", h] ""
-    notify res = let j = isJust res
+    notify res =
+      let j = isJust res
       in notifyStatus j $ if j then "sync succeeded" else "sync failed"

-getSession' :: BWServerConf -> Session -> IO (Maybe String)
+getSession' :: MonadUnliftIO m => BWServerConf -> Session -> m (Maybe T.Text)
 getSession' BWServerConf {timeout = t} ses = do
-  ut <- getUnixTime
+  ut <- liftIO $ getUnixTime
  modifyMVar ses $ \s -> case s of
    Just CurrentSession {timestamp = ts, hash = h} ->
      if diffUnixTime ut ts > t then getNewSession else return (s, Just h)
@ -82,24 +73,26 @@ getSession' BWServerConf { timeout = t } ses = do
      newHash <- join <$> mapM readSession pwd
      (,newHash) <$> mapM newSession newHash
    newSession h = do
-      ut <- getUnixTime
+      ut <- liftIO $ getUnixTime
      return CurrentSession {timestamp = ut, hash = h}

-getSession :: BWServerConf -> Session -> IO String
+getSession :: MonadUnliftIO m => BWServerConf -> Session -> m T.Text
 getSession conf ses = fromMaybe "" <$> getSession' conf ses

-readSession :: String -> IO (Maybe String)
+readSession :: MonadIO m => T.Text -> m (Maybe T.Text)
 readSession pwd = readCmdSuccess "bw" ["unlock", pwd, "--raw"] ""

-notifyStatus :: Bool -> String -> IO ()
+notifyStatus :: MonadIO m => Bool -> T.Text -> m ()
 notifyStatus succeeded msg =
-  void $ spawnProcess "notify-send" ["-i", i, msg]
+  void $ liftIO $ spawnProcess "notify-send" ["-i", i, T.unpack msg]
  where
-    i = if succeeded
+    i =
+      if succeeded
        then "dialog-information-symbolic"
        else "dialog-error-symbolic"

 --------------------------------------------------------------------------------
+
 -- | Client
 --
 -- The client will get the current session from the daemon (if it can) and then
@ -114,55 +107,63 @@ notifyStatus succeeded msg =
 --     - username (if applicable) -> copy to clipboard
 --     - password (if applicable) -> copy to clipboard
 --     - anything else (notes and such) -> copy to clipboard
+data BWClientConf c = BWClientConf
+  { bwArgs :: ![T.Text]
+  , bwEnv :: !c
+  }

-newtype BWClientConf = BWClientConf [String]
+instance HasRofiConf (BWClientConf c) where
+  defArgs = bwArgs

-instance RofiConf BWClientConf where
-  defArgs (BWClientConf a) = a
+instance HasLogFunc c => HasLogFunc (BWClientConf c) where
+  logFuncL = lens bwEnv (\x y -> x {bwEnv = y}) . logFuncL

-runClient :: [String] -> IO ()
-runClient a = do
-  let c = BWClientConf a
-  runRofiIO c $ selectAction $ emptyMenu
+runClient :: HasLogFunc c => [T.Text] -> RIO c ()
+runClient a =
+  mapRIO (BWClientConf a) $
+    selectAction $
+      emptyMenu
        { groups = [untitledGroup $ toRofiActions ras]
        , prompt = Just "Action"
        }
  where
-    ras = [ ("Browse Logins", browseLogins)
-          , ("Sync Session", io callSyncSession)
-          , ("Lock Session", io callLockSession)
+    ras =
+      [ ("Browse Logins", browseLogins)
+      , ("Sync Session", callSyncSession)
+      , ("Lock Session", callLockSession)
      ]

-browseLogins :: RofiConf c => RofiIO c ()
-browseLogins = io getItems >>= selectItem
+browseLogins :: (HasLogFunc c, HasRofiConf c) => RIO c ()
+browseLogins = getItems >>= selectItem

-getItems :: IO [Item]
+getItems :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => m [Item]
 getItems = maybe (return []) getItems' =<< callGetSession

-getItems' :: String -> IO [Item]
+getItems' :: MonadIO m => T.Text -> m [Item]
 getItems' session = do
-  items <- io $ readProcess "bw" ["list", "items", "--session", session] ""
+  items <- liftIO $ readProcess "bw" ["list", "items", "--session", T.unpack session] ""
  return $ filter notEmpty $ fromMaybe [] $ decode $ fromString items
  where
-    notEmpty Item { login = Login { username = Nothing, password = Nothing } }
-      = False
+    notEmpty Item {login = Login {username = Nothing, password = Nothing}} =
+      False
    notEmpty _ = True

 data Item = Item
-    { name  :: String
+  { name :: T.Text
  , login :: Login
  }
  deriving (Show)

 instance FromJSON Item where
-  parseJSON (Object o) = Item
+  parseJSON (Object o) =
+    Item
      <$> o .: "name"
      <*> o .:? "login" .!= Login {username = Nothing, password = Nothing}
  parseJSON _ = mzero

 data Login = Login
-    { username :: Maybe String
-    , password :: Maybe String
+  { username :: Maybe T.Text
+  , password :: Maybe T.Text
  }
  deriving (Show, Generic)

@ -170,74 +171,89 @@ instance FromJSON Login

 -- TODO make menu buttons here to go back and to copy without leaving
 -- the current menu
-selectItem :: RofiConf c => [Item] -> RofiIO c ()
-selectItem items = selectAction $ emptyMenu
+selectItem :: (HasLogFunc c, HasRofiConf c) => [Item] -> RIO c ()
+selectItem items =
+  selectAction $
+    emptyMenu
      { groups = [untitledGroup $ itemsToRofiActions items]
      , prompt = Just "Login"
      }

-itemsToRofiActions :: RofiConf c => [Item] -> RofiActions c
+itemsToRofiActions :: (HasLogFunc c, HasRofiConf c) => [Item] -> RofiActions c
 itemsToRofiActions = toRofiActions . fmap (\i -> (name i, selectCopy $ login i))

-selectCopy :: RofiConf c => Login -> RofiIO c ()
-selectCopy l = selectAction $ emptyMenu
+selectCopy :: (HasLogFunc c, HasRofiConf c) => Login -> RIO c ()
+selectCopy l =
+  selectAction $
+    emptyMenu
      { groups = [untitledGroup $ loginToRofiActions l copy]
      , prompt = Just "Copy"
      , hotkeys = [copyHotkey, backHotkey]
      }
  where
-    copy = io . setClipboardString
+    copy = io . setClipboardString . T.unpack
    copyRepeat s = copy s >> selectCopy l
-    copyHotkey = Hotkey
+    copyHotkey =
+      Hotkey
        { keyCombo = "Alt+c"
-      , keyIndex = 1
        , keyDescription = "Copy One"
        , keyActions = loginToRofiActions l copyRepeat
        }
-    backHotkey = Hotkey
+    backHotkey =
+      Hotkey
        { keyCombo = "Alt+q"
-      , keyIndex = 2
        , keyDescription = "Back"
-      -- TODO this is overly complicated, all entries do the same thing
+        , -- TODO this is overly complicated, all entries do the same thing
          -- TODO this is slow, we can cache the logins somehow...
-      , keyActions = loginToRofiActions l (const browseLogins)
+          keyActions = loginToRofiActions l (const browseLogins)
        }

-loginToRofiActions :: RofiConf c => Login -> (String -> RofiIO c ()) -> RofiActions c
+loginToRofiActions :: Login -> (T.Text -> RIO c ()) -> RofiActions c
 loginToRofiActions Login {username = u, password = p} a =
  toRofiActions $ catMaybes [user, pwd]
  where
    copyIfJust f = fmap $ liftM2 (,) f a
-    fmtUsername s = "Username (" ++ s ++ ")"
-    fmtPassword s = "Password (" ++ take 32 (replicate (length s) '*') ++ ")"
+    fmtUsername s = T.concat ["Username (", s, ")"]
+    fmtPassword s = T.concat ["Password (", T.take 32 (T.replicate (T.length s) "*"), ")"]
    user = copyIfJust fmtUsername u
    pwd = copyIfJust fmtPassword p

-getItemPassword' :: BWServerConf -> Session -> String -> IO (Maybe String)
+getItemPassword' :: MonadUnliftIO m => BWServerConf -> Session -> T.Text -> m (Maybe T.Text)
 getItemPassword' conf session item = mapM getPwd =<< getSession' conf session
  where
-    getPwd s = readProcess "bw" ["get", "password", item, "--session", s] ""
+    getPwd = fmap T.pack . pr
+    pr s =
+      liftIO $
+        readProcess
+          "bw"
+          ["get", "password", T.unpack item, "--session", T.unpack s]
+          ""

-getItemPassword :: BWServerConf -> Session -> String -> IO String
-getItemPassword conf session item = fromMaybe "" <$>
-  getItemPassword' conf session item
+getItemPassword :: MonadUnliftIO m => BWServerConf -> Session -> T.Text -> m T.Text
+getItemPassword conf session item =
+  fromMaybe ""
+    <$> getItemPassword' conf session item

 --------------------------------------------------------------------------------
-- | DBus

-startService :: BWServerConf -> Session -> IO ()
+-- | DBus
+startService :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => BWServerConf -> Session -> m ()
 startService c ses = do
-  client <- connectSession
+  client <- liftIO $ connectSession
  let flags = [nameAllowReplacement, nameReplaceExisting]
-  _ <- requestName client busname flags
-  putStrLn "Started rofi bitwarden dbus client"
-  export client path defaultInterface
+  _ <- liftIO $ requestName client busname flags
+  logInfo "Started rofi bitwarden dbus client"
+  withRunInIO $ \runIO ->
+    export
+      client
+      path
+      defaultInterface
        { interfaceName = interface
        , interfaceMethods =
-      [ autoMethod memGetSession $ getSession c ses
-      , autoMethod memLockSession $ lockSession ses
-      , autoMethod memSyncSession $ syncSession c ses
-      , autoMethod memGetPassword $ getItemPassword c ses
+            [ autoMethod memGetSession $ runIO $ getSession c ses
+            , autoMethod memLockSession $ runIO $ lockSession ses
+            , autoMethod memSyncSession $ runIO $ syncSession c ses
+            , autoMethod memGetPassword $ runIO . getItemPassword c ses
            ]
        }

@ -262,32 +278,37 @@ memSyncSession = "SyncSession"
 memGetPassword :: MemberName
 memGetPassword = "GetPassword"

-callMember :: MemberName -> IO [Variant]
+callMember :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => MemberName -> m [Variant]
 callMember m = do
  reply <- callMethod $ methodCall path interface m
  case reply of
-    Left err   -> putStrLn (methodErrorMessage err) >> return []
+    Left err -> do
+      logError $
+        displayBytesUtf8 $
+          encodeUtf8 $
+            (T.pack (methodErrorMessage err))
+      return []
    Right body -> return body

-callLockSession :: IO ()
+callLockSession :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => m ()
 callLockSession = void $ callMember memLockSession

-callSyncSession :: IO ()
+callSyncSession :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => m ()
 callSyncSession = void $ callMember memSyncSession

-callGetSession :: IO (Maybe String)
+callGetSession :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => m (Maybe T.Text)
 callGetSession = getBodyString <$> callMember memGetSession

 -- TODO maybe will need to add a caller for getItemPassword

-getBodyString :: [Variant] -> Maybe String
-getBodyString [b] = case fromVariant b :: Maybe String of
+getBodyString :: [Variant] -> Maybe T.Text
+getBodyString [b] = case fromVariant b :: Maybe T.Text of
  Just "" -> Nothing
  s -> s
 getBodyString _ = Nothing

-callMethod :: MethodCall -> IO (Either MethodError [Variant])
-callMethod mc = do
+callMethod :: MonadIO m => MethodCall -> m (Either MethodError [Variant])
+callMethod mc = liftIO $ do
  client <- connectSession
  reply <- call client mc {methodCallDestination = Just busname}
  disconnect client
--- a/lib/Rofi/Command.hs
+++ b/lib/Rofi/Command.hs
@ -1,16 +1,12 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
 module Rofi.Command
-  ( RofiConf(..)
+  ( HasRofiConf (..)
  , RofiMenu (..)
  , RofiAction
  , RofiActions
-  , RofiIO
  , RofiGroup
  , Hotkey (..)
  , io
  , emptyMenu
-  , runRofiIO
  , toRofiActions
  , rofiActionKeys
  , untitledGroup
@ -23,170 +19,180 @@ module Rofi.Command
  , readCmdEither'
  , dmenuArgs
  , joinNewline
-  , stripWS
-  ) where
+  , runRofi
+  )
+where

-import           Control.Monad.IO.Unlift
-import           Control.Monad.Reader
-
-import           Data.Char
-import           Data.List
-import qualified Data.Map.Ordered        as M
-import           Data.Maybe
-
-import           System.Exit
+import qualified Data.Map.Ordered as OM
+import RIO
+import qualified RIO.List as L
+import qualified RIO.Text as T
+import qualified RIO.Vector.Boxed as V
 import System.Process

-class RofiConf c where
-  defArgs :: c -> [String]
+class HasRofiConf c where
+  defArgs :: c -> [T.Text]

-type RofiAction c = (String, RofiIO c ())
+type RofiAction c = (T.Text, RIO c ())

-type RofiActions c = M.OMap String (RofiIO c ())
+type RofiActions c = OM.OMap T.Text (RIO c ())

 data RofiGroup c = RofiGroup
  { actions :: RofiActions c
-    , title   :: Maybe String
+  , title :: Maybe T.Text
  }

 untitledGroup :: RofiActions c -> RofiGroup c
 untitledGroup a = RofiGroup {actions = a, title = Nothing}

-titledGroup :: String -> RofiActions c -> RofiGroup c
+titledGroup :: T.Text -> RofiActions c -> RofiGroup c
 titledGroup t a = (untitledGroup a) {title = Just t}

 data Hotkey c = Hotkey
-    { keyCombo       :: String
-    -- only 1-10 are valid
-    , keyIndex       :: Int
-    , keyDescription :: String
+  { keyCombo :: !T.Text
+  , keyDescription :: !T.Text
  , keyActions :: RofiActions c
  }

-hotkeyBinding :: Hotkey c -> [String]
-hotkeyBinding Hotkey { keyIndex = e, keyCombo = c } = [k, c]
+hotkeyBinding :: Int -> Hotkey c -> [T.Text]
+hotkeyBinding i Hotkey {keyCombo = c} = [k, c]
  where
-    k = "-kb-custom-" ++ show e
+    k = T.append "-kb-custom-" $ T.pack $ show i

-hotkeyMsg1 :: Hotkey c -> String
+hotkeyMsg1 :: Hotkey c -> T.Text
 hotkeyMsg1 Hotkey {keyCombo = c, keyDescription = d} =
-  c ++ ": <i>" ++ d ++ "</i>"
+  T.concat [c, ": <i>", d, "</i>"]

-hotkeyMsg :: [Hotkey c] -> [String]
+hotkeyMsg :: [Hotkey c] -> [T.Text]
 hotkeyMsg [] = []
-hotkeyMsg hs = ["-mesg", intercalate " | " $ fmap hotkeyMsg1 hs]
+hotkeyMsg hs = ["-mesg", T.intercalate " | " $ fmap hotkeyMsg1 hs]

-hotkeyArgs :: [Hotkey c] -> [String]
-hotkeyArgs hks = hotkeyMsg hks ++ concatMap hotkeyBinding hks
+hotkeyArgs :: [Hotkey c] -> [T.Text]
+hotkeyArgs hks =
+  (hotkeyMsg hks)
+    ++ (concatMap (uncurry hotkeyBinding) $ take 19 $ zip [1 ..] hks)

 data RofiMenu c = RofiMenu
-    { groups  :: [RofiGroup c]
-    , prompt  :: Maybe String
-    , hotkeys :: [Hotkey c]
+  { groups :: ![RofiGroup c]
+  , prompt :: !(Maybe T.Text)
+  , hotkeys :: ![Hotkey c]
  }

 emptyMenu :: RofiMenu c
-emptyMenu = RofiMenu
+emptyMenu =
+  RofiMenu
    { groups = []
    , prompt = Nothing
-  , hotkeys = []
+    , hotkeys = mempty
    }

-newtype RofiIO c a = RofiIO (ReaderT c IO a)
-    deriving (Functor, Monad, MonadIO, MonadReader c, MonadUnliftIO)
-
-instance Applicative (RofiIO c) where
-  pure = return
-  (<*>) = ap
-
 io :: MonadIO m => IO a -> m a
 io = liftIO

-runRofiIO :: c -> RofiIO c a -> IO a
-runRofiIO c (RofiIO r) = runReaderT r c
+toRofiActions :: [(T.Text, RIO c ())] -> RofiActions c
+toRofiActions = OM.fromList

-toRofiActions :: [(String, RofiIO c ())] -> RofiActions c
-toRofiActions = M.fromList
+rofiActionKeys :: RofiActions c -> T.Text
+rofiActionKeys = joinNewline . map fst . OM.assocs

-rofiActionKeys :: RofiActions c -> String
-rofiActionKeys = joinNewline . map fst . M.assocs
+lookupRofiAction :: T.Text -> RofiActions c -> RIO c ()
+lookupRofiAction key = fromMaybe err . OM.lookup key
+  where
+    err = error $ T.unpack $ T.concat ["could not lookup key: '", key, "'"]

-lookupRofiAction :: String -> RofiActions c -> RofiIO c ()
-lookupRofiAction key ras = fromMaybe (return ()) $ M.lookup key ras
-
-groupEntries :: RofiGroup c -> String
+groupEntries :: RofiGroup c -> T.Text
 groupEntries RofiGroup {actions = a, title = t}
  | null a = ""
-  | otherwise = title' ++ rofiActionKeys a
+  | otherwise = T.append title' $ rofiActionKeys a
  where
-    title' = maybe "" (++ "\n") t
+    title' = maybe "" (`T.append` "\n") t

 menuActions :: RofiMenu c -> RofiActions c
-menuActions = foldr1 (M.<>|) . fmap actions . groups
+menuActions = L.foldr (OM.<>|) OM.empty . fmap actions . groups

-menuEntries :: RofiMenu c -> String
-menuEntries = intercalate "\n\n" . filter (not . null) . fmap groupEntries . groups
+menuEntries :: RofiMenu c -> T.Text
+menuEntries = T.intercalate "\n\n" . filter (not . T.null) . fmap groupEntries . groups

-selectAction :: RofiConf c => RofiMenu c -> RofiIO c ()
+selectAction :: HasRofiConf c => RofiMenu c -> RIO c ()
 selectAction rm = do
  let p = maybeOption "-p" $ prompt rm
  let hArgs = hotkeyArgs $ hotkeys rm
  res <- readRofi (p ++ hArgs) $ menuEntries rm
  case res of
    Right key -> lookupRofiAction key $ menuActions rm
-    Left (n, key, _) -> mapM_ (lookupRofiAction key . keyActions)
-      $ find ((==) n . (+ 9) . keyIndex)
-      $ hotkeys rm
+    Left (1, _, _) -> exitWith $ ExitFailure 1
+    Left (n, key, _) -> do
+      maybe
+        (error $ T.unpack $ T.append "could not find key index: " $ T.pack $ show n)
+        (lookupRofiAction key . keyActions)
+        -- this sketchy assumption has to do with the fact that the custom
+        -- keybindings are labeled 1-19 and thus need to be explicitly
+        -- indexed, and the program itself tells the world which key was
+        -- pressed via return code (any possible integer)
+        ((V.fromList $ hotkeys rm) V.!? (n - 10))

-maybeOption :: String -> Maybe String -> [String]
+runRofi :: (MonadIO m, HasRofiConf c) => c -> RofiMenu c -> m ()
+runRofi c = runRIO c . selectAction
+
+maybeOption :: T.Text -> Maybe T.Text -> [T.Text]
 maybeOption switch = maybe [] (\o -> [switch, o])

-dmenuArgs :: [String]
+dmenuArgs :: [T.Text]
 dmenuArgs = ["-dmenu"]

-readRofi :: RofiConf c => [String]
-  -> String
-  -> RofiIO c (Either (Int, String, String) String)
+readRofi
+  :: HasRofiConf c
+  => [T.Text]
+  -> T.Text
+  -> RIO c (Either (Int, T.Text, T.Text) T.Text)
 readRofi uargs input = do
  dargs <- asks defArgs
  io $ readCmdEither "rofi" (dmenuArgs ++ dargs ++ uargs) input

-readCmdSuccess :: String -> [String] -> String -> IO (Maybe String)
-readCmdSuccess cmd args input = either (const Nothing) Just
+readCmdSuccess :: MonadIO m => T.Text -> [T.Text] -> T.Text -> m (Maybe T.Text)
+readCmdSuccess cmd args input =
+  either (const Nothing) Just
    <$> readCmdEither cmd args input

-readCmdEither :: String
-  -> [String]
-  -> String
-  -> IO (Either (Int, String, String) String)
-readCmdEither cmd args input = resultToEither
-  <$> readProcessWithExitCode cmd args input
+readCmdEither
+  :: MonadIO m
+  => T.Text
+  -> [T.Text]
+  -> T.Text
+  -> m (Either (Int, T.Text, T.Text) T.Text)
+readCmdEither cmd args input = readCmdEither' cmd args input []

-readCmdEither' :: String
-  -> [String]
-  -> String
-  -> [(String, String)]
-  -> IO (Either (Int, String, String) String)
-readCmdEither' cmd args input environ = resultToEither
-  <$> readCreateProcessWithExitCode p input
+readCmdEither'
+  :: MonadIO m
+  => T.Text
+  -> [T.Text]
+  -> T.Text
+  -> [(T.Text, T.Text)]
+  -> m (Either (Int, T.Text, T.Text) T.Text)
+readCmdEither' cmd args input environ =
+  resultToEither
+    <$> (liftIO $ readCreateProcessWithExitCode p (T.unpack input))
  where
-    p = (proc cmd args) { env = Just environ }
+    e = case environ of
+      [] -> Nothing
+      es -> Just $ fmap (bimap T.unpack T.unpack) es
+    p = (proc (T.unpack cmd) (fmap T.unpack args)) {env = e}

-resultToEither :: (ExitCode, String, String)
-  -> Either (Int, String, String) String
-resultToEither (ExitSuccess, out, _)     = Right $ stripWS out
-resultToEither (ExitFailure n, out, err) = Left (n, stripWS out, stripWS err)
+-- TODO why strip whitespace?
+resultToEither
+  :: (ExitCode, String, String)
+  -> Either (Int, T.Text, T.Text) T.Text
+resultToEither (ExitSuccess, out, _) = Right $ T.stripEnd $ T.pack out
+resultToEither (ExitFailure n, out, err) =
+  Left (n, T.stripEnd $ T.pack out, T.stripEnd $ T.pack err)

-stripWS :: String -> String
-stripWS = reverse . dropWhile isSpace . reverse
+joinNewline :: [T.Text] -> T.Text
+joinNewline = T.intercalate "\n"

-joinNewline :: [String] -> String
-joinNewline = intercalate "\n"
-
-readPassword :: IO (Maybe String)
+readPassword :: MonadIO m => m (Maybe T.Text)
 readPassword = readPassword' "Password"

-readPassword' :: String -> IO (Maybe String)
+readPassword' :: MonadIO m => T.Text -> m (Maybe T.Text)
 readPassword' p = readCmdSuccess "rofi" args ""
  where
    args = dmenuArgs ++ ["-p", p, "-password"]
--- a/lib/Rofi/IO.hs
+++ b/lib/Rofi/IO.hs
@ -0,0 +1,29 @@
+module Rofi.IO where
+
+import RIO
+import RIO.Directory
+import qualified RIO.Text as T
+import System.Process
+
+data NotifyIcon = IconError | IconInfo
+
+instance Show NotifyIcon where
+  show IconError = "dialog-error-symbolic"
+  show IconInfo = "dialog-information-symbolic"
+
+notify :: MonadIO m => NotifyIcon -> T.Text -> Maybe T.Text -> m ()
+notify icon summary body =
+  liftIO $
+    void $
+      spawnProcess "notify-send" $
+        maybe args (\b -> args ++ [b]) $
+          fmap T.unpack body
+  where
+    args = ["-i", show icon, T.unpack summary]
+
+checkExe :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => FilePath -> m ()
+checkExe cmd = do
+  res <- findExecutable cmd
+  unless (isJust res) $ do
+    logError $ displayBytesUtf8 $ encodeUtf8 $ T.append "Could not find executable: " $ T.pack cmd
+    exitWith $ ExitFailure 1
--- a/5
+++ b/5
@ -0,0 +1,5 @@
+libx11
+libxrandr
+libxss
+libxext
+zlib
--- a/package.yaml
+++ b/package.yaml
@ -9,15 +9,56 @@ copyright:           "2020 Nathan Dwarshuis"
 extra-source-files:
 - README.md

-# Metadata used when publishing your package
-# synopsis:            Short description of your package
-# category:            Web
-
-# To avoid duplicated efforts in documentation and dealing with the
-# complications of embedding Haddock markup inside cabal files, it is
-# common to point users to the README.md file.
 description:         Please see the README on GitHub at <https://github.com/ndwarshuis/rofi-extras#readme>

+default-extensions:
+  - OverloadedStrings
+  - FlexibleContexts
+  - FlexibleInstances
+  - InstanceSigs
+  - MultiParamTypeClasses
+  - EmptyCase
+  - LambdaCase
+  - MultiWayIf
+  - NamedFieldPuns
+  - TupleSections
+  - DeriveFoldable
+  - DeriveFunctor
+  - DeriveGeneric
+  - DeriveLift
+  - DeriveTraversable
+  - DerivingStrategies
+  - DeriveDataTypeable
+  - EmptyDataDecls
+  - PartialTypeSignatures
+  - GeneralizedNewtypeDeriving
+  - StandaloneDeriving
+  - BangPatterns
+  - TypeOperators
+  - ScopedTypeVariables
+  - TypeApplications
+  - ConstraintKinds
+  - RankNTypes
+  - GADTs
+  - DefaultSignatures
+  - NoImplicitPrelude
+  - FunctionalDependencies
+  - DataKinds
+  - TypeFamilies
+  - BinaryLiterals
+  - ViewPatterns
+
+ghc-options:
+- -Wall
+- -Wcompat
+- -Widentities
+- -Wincomplete-record-updates
+- -Wincomplete-uni-patterns
+- -Wredundant-constraints
+- -Wpartial-fields
+- -Werror
+- -O2
+
 dependencies:
 - base >= 4.7 && < 5
 - process >= 1.6.5.0
@ -40,24 +81,18 @@ dependencies:
 - yaml >= 0.11.1.2
 - vector >= 0.12.0.3
 - bimap >= 0.2.4
+- dhall >= 1.40.2
+- lens >= 5.0.1
+- rio

 library:
  source-dirs: lib/
-  ghc-options:
-  - -Wall
-  - -Werror
-  - -threaded
-  exposed-modules:
-  - Bitwarden.Internal
-  - Rofi.Command

 executables:
  pinentry-rofi:
    main: pinentry-rofi.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras
@ -66,8 +101,6 @@ executables:
    main: rofi-autorandr.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras
@ -76,8 +109,6 @@ executables:
    main: rofi-bw.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras
@ -86,8 +117,6 @@ executables:
    main: rofi-bt.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras
@ -96,8 +125,6 @@ executables:
    main: rofi-dev.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras
@ -106,18 +133,14 @@ executables:
    main: rofi-evpn.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras

-  current-output:
-    main: current-output.hs
+  rofi:
+    main: rofi.hs
    source-dirs: app
    ghc-options:
-    - -Wall
-    - -Werror
    - -threaded
    dependencies:
    - rofi-extras
--- a/34
+++ b/34
@ -0,0 +1,34 @@
+#!/bin/bash
+
+# Show the Pacman/AUR packages necessary for various components in this repo.
+
+# NOTE: this does not list the build dependencies (x11 and friends)
+
+pkgs=(rofi)
+
+while [ "$#" -gt 0 ]; do
+    case "$1" in
+        -a|--autorandr)
+            pkgs+=(autorandr)
+            ;;
+        -b|--bitwarden)
+            pkgs+=(bitwarden-cli libnotify)
+            ;;
+        -d|--devices)
+            pkgs+=(udisks2 cifs-utils veracrypt sshfs jmtpfs libnotify libsecret)
+            ;;
+        -B|--bluetooth)
+            pkgs+=(bluez)
+            ;;
+        -e|--expressvpn)
+            pkgs+=(expressvpn libnotify)
+            ;;
+        *)
+            echo "unknown option: $1"
+            exit 1
+            ;;
+    esac
+    shift
+done
+
+echo "${pkgs[@]}" | tr ' ' '\n' | sort | uniq
--- a/scripts/gpg
+++ b/scripts/gpg
@ -0,0 +1,5 @@
+#! /bin/bash
+
+## gpg (override): mount GNUPGHOME before executing
+
+with_gpg_mount /usr/bin/gpg "$@"
--- a/scripts/mount.veracrypt
+++ b/scripts/mount.veracrypt
@ -0,0 +1,30 @@
+#! /bin/bash
+
+## mount a veracrypt volume
+
+## NOTE this will need the DISPLAY variable in order to prompt for the bitwarden
+## password
+pwd=$(dbus-send --print-reply=literal --session \
+                --dest=org.rofi.bitwarden \
+                /bitwarden org.rofi.bitwarden.session.GetPassword \
+                string:"$1" | \
+          sed -e 's/^ *//g')
+
+## the funny evals are here to expand any literal env variables that may be
+## passed because systemd didn't expand them (yuck)
+volume="$(eval echo "$2")"
+mountpoint="$(eval echo "$3")"
+
+if [[ "$pwd" == "" ]]; then
+    echo "Could not get bitwarden password"
+    exit 1
+else
+    if /usr/bin/sudo /usr/bin/veracrypt \
+                     --text --non-interactive --stdin \
+                     "$volume" "$mountpoint" <<< "$pwd"; then
+        echo "Mounted $1"
+    else
+        echo "Failed to mount $1"
+        exit 1
+    fi
+fi
--- a/scripts/pass
+++ b/scripts/pass
@ -0,0 +1,5 @@
+#! /bin/bash
+
+## pass (override): mount $GNUPGHOME before executing
+
+with_gpg_mount /usr/bin/pass "$@"
--- a/scripts/umount.veracrypt
+++ b/scripts/umount.veracrypt
@ -0,0 +1,14 @@
+#! /bin/bash
+
+## unmount a veracrypt volume
+
+## the funny evals are here to expand any literal env variables that may be
+## passed because systemd didn't expand them (yuck)
+mountpoint="$(eval echo "$1")"
+
+if /usr/bin/sudo /usr/bin/veracrypt -d "$mountpoint"; then
+    echo "Unmounted $1"
+else
+    echo "Failed to unmount $1"
+    exit 1
+fi
--- a/scripts/with_gpg_mount
+++ b/scripts/with_gpg_mount
@ -0,0 +1,14 @@
+#! /bin/bash
+
+## with_gpg_mount: call a program after mounting GNUPGHOME using rofi
+
+bin="$1"
+shift
+
+alias="gnupg"
+
+if rofi-dev -c "$XDG_CONFIG_HOME/rofi/devices.dhall" -m "$alias"; then
+    "$bin" "$@"
+else
+    echo "Could not mount $alias"
+fi
--- a/stack.yaml
+++ b/stack.yaml
@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-16.31
+resolver: lts-20.11

 # User packages to be built.
 # Various formats can be used as shown in the example below.
@ -64,11 +64,3 @@ packages:
 #
 # Allow a newer minor version of GHC than the snapshot specifies
 # compiler-check: newer-minor
-nix:
-  enable: true
-  packages:
-    - xorg.libX11
-    - xorg.libXrandr
-    - xorg.libXScrnSaver
-    - xorg.libXext
-    - zlib
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 534126
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
-    sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6
-  original: lts-16.31
+    sha256: adbc602422dde10cc330175da7de8609e70afc41449a7e2d6e8b1827aa0e5008
+    size: 649342
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/11.yaml
+  original: lts-20.11
Author	SHA1	Message	Date
Nathan Dwarshuis	5a9f421dcb	FIX pinentry bug	2024-03-13 21:58:28 -04:00
Nathan Dwarshuis	ae5de98e46	ADD lots of little files that were scattered around	2024-01-07 11:50:22 -05:00
Nathan Dwarshuis	a963be1421	ENH revert failed last two commits	2024-01-07 11:49:30 -05:00
Nathan Dwarshuis	04c430efc6	REF clean up nondry code	2023-02-22 23:02:04 -05:00
Nathan Dwarshuis	c3fc38d785	REF wrap everything in simpleapp	2023-02-22 22:44:44 -05:00
Nathan Dwarshuis	05ecda045e	REF bracket display lookup	2023-02-16 22:53:00 -05:00
Nathan Dwarshuis	6acd60187e	FIX return codes from keys	2023-02-16 22:40:24 -05:00
Nathan Dwarshuis	57b4c2d805	REF use text fun	2023-02-15 22:45:23 -05:00
Nathan Dwarshuis	b6f32a1b0f	REF clean up process functions	2023-02-15 22:43:46 -05:00
Nathan Dwarshuis	9086915e52	FIX don't pad all segments	2023-02-15 22:41:17 -05:00
Nathan Dwarshuis	2584df39a5	REF some stuff	2023-02-14 23:32:04 -05:00
Nathan Dwarshuis	1e54682f1c	REF remove partial lists from dev	2023-02-14 23:09:12 -05:00
Nathan Dwarshuis	49c3947b5a	REF use rio monad for rofi	2023-02-14 22:28:26 -05:00
Nathan Dwarshuis	9fcdd1b5f1	ENH import dhall types dynamically	2023-02-14 00:37:50 -05:00
Nathan Dwarshuis	09ce10a942	REF use text everywhere	2023-02-13 23:31:50 -05:00
Nathan Dwarshuis	4265a5947c	REF use rio and better flags	2023-02-13 22:19:49 -05:00
Nathan Dwarshuis	cfe0607e2e	ADD dismount all option	2023-01-24 09:22:19 -05:00
Nathan Dwarshuis	7094dac44e	ENH kill stylish haskell with fury	2023-01-24 09:22:09 -05:00
Nathan Dwarshuis	e13e4150fd	ADD formatting config	2023-01-24 09:21:46 -05:00
Nathan Dwarshuis	3e9b08db08	ENH call rofi directly	2022-08-07 22:18:40 -04:00
Nathan Dwarshuis	d06d5d5a0b	ENH inject config types into dhall code	2022-08-07 13:55:41 -04:00
Nathan Dwarshuis	74070ebb30	ENH use dhall for config	2022-08-07 11:42:06 -04:00
Nathan Dwarshuis	f09f636f56	ENH update resolver	2022-08-06 18:50:45 -04:00
Nathan Dwarshuis	a1b84ab4f2	FIX typo	2022-08-01 00:31:05 -04:00
Nathan Dwarshuis	a1b5c64e62	REF rename runtime package lister	2022-07-31 23:30:56 -04:00
Nathan Dwarshuis	7bf89de504	REF make script easier to read	2022-07-31 23:12:53 -04:00
Nathan Dwarshuis	76d09200a5	ENH move install script to scripts dir and print pkgs	2022-07-31 21:28:45 -04:00
Nathan Dwarshuis	cd53449266	ENH update readme	2022-07-31 21:04:19 -04:00
Nathan Dwarshuis	f84407b793	FIX don't use partial fields	2022-07-31 20:30:27 -04:00
Nathan Dwarshuis	5fb8b404dc	FIX make program not puke if jmtpfs is not found (even when not needed)	2022-07-26 23:17:20 -04:00
Nathan Dwarshuis	2bd8decb52	ADD build deps list	2022-07-26 22:48:57 -04:00