diff options
-rw-r--r-- | CmdLine.hs | 6 | ||||
-rw-r--r-- | UI.hs | 17 | ||||
-rw-r--r-- | UI/Zenity.hs | 2 | ||||
-rw-r--r-- | keysafe.cabal | 1 | ||||
-rw-r--r-- | keysafe.hs | 2 |
5 files changed, 25 insertions, 3 deletions
@@ -14,6 +14,7 @@ data CmdLine = CmdLine , name :: Name , keytype :: KeyType , testMode :: Bool + , gui :: Bool } deriving (Show) @@ -26,6 +27,7 @@ parse = CmdLine <*> nameopt <*> keytypeopt <*> testmodeswitch + <*> guiswitch where backup = flag' Backup ( long "backup" @@ -47,6 +49,10 @@ parse = CmdLine ( long "testmode" <> help "Avoid using expensive cryptographic operation to secure key. Use for testing only, not with real secret keys." ) + guiswitch = switch + ( long "gui" + <> help "Use GUI interface for interaction. Default is to use readline interface when run in a terminal, and GUI otherwise." + ) get :: IO CmdLine get = execParser opts @@ -10,5 +10,18 @@ import Control.Monad import UI.Zenity import UI.Readline -availableUI :: IO [UI] -availableUI = filterM isAvailable [zenityUI, readlineUI] +availableUIs :: IO [UI] +availableUIs = filterM isAvailable [zenityUI, readlineUI] + +selectUI :: Bool -> IO UI +selectUI needgui + | needgui = do + ok <- isAvailable zenityUI + if ok + then return zenityUI + else error "zenitty is not installed, GUI not available" + | otherwise = do + l <- availableUIs + case l of + (u:_) -> return u + [] -> error "Neither zenity nor the readline UI are available" diff --git a/UI/Zenity.hs b/UI/Zenity.hs index 5eb4bef..3b8b028 100644 --- a/UI/Zenity.hs +++ b/UI/Zenity.hs @@ -5,8 +5,8 @@ module UI.Zenity (zenityUI) where -import UI import Types +import Types.UI import Control.Monad import System.Process import Control.Exception diff --git a/keysafe.cabal b/keysafe.cabal index aa212b1..28fa921 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -32,6 +32,7 @@ Executable keysafe , unix == 2.7.* , filepath == 1.4.* , directory == 1.2.* + , process == 1.2.* , optparse-applicative == 0.12.* , readline == 1.0.* @@ -10,6 +10,7 @@ module Main where import Types import Tunables import qualified CmdLine +import UI import Encryption import Cost import Shard @@ -19,6 +20,7 @@ import Storage.LocalFiles main :: IO () main = do cmdline <- CmdLine.get + ui <- selectUI (CmdLine.gui cmdline) let name = CmdLine.name cmdline let keytype = CmdLine.keytype cmdline -- TODO determine gpg key id by examining secret key, |