support for questions

4 files changed, 21 insertions, 11 deletions

diff --git a/sequence.cabal b/sequence.cabal
index 3d9e66f..ada1546 100644
--- a/sequence.cabal
+++ b/sequence.cabal
@@ -33,5 +33,6 @@ executable sequence
                      , mtl
                      , table-layout
                      , game-probability
+                     , readline
   hs-source-dirs:      src
   default-language:    Haskell2010
\ No newline at end of file
diff --git a/sequence.nix b/sequence.nix
index 4533ad2..ff36401 100644
--- a/sequence.nix
+++ b/sequence.nix
@@ -1,6 +1,7 @@
 { mkDerivation, base, bimap, case-insensitive, containers
 , data-default, directory, filepath, game-probability, lens, mtl
-, Shellac, Shellac-haskeline, stdenv, table-layout, xdg-basedir
+, readline, Shellac, Shellac-haskeline, stdenv, table-layout
+, xdg-basedir
 }:
 mkDerivation {
   pname = "sequence";
@@ -10,8 +11,8 @@ mkDerivation {
   isExecutable = true;
   executableHaskellDepends = [
     base bimap case-insensitive containers data-default directory
-    filepath game-probability lens mtl Shellac Shellac-haskeline
-    table-layout xdg-basedir
+    filepath game-probability lens mtl readline Shellac
+    Shellac-haskeline table-layout xdg-basedir
   ];
   license = stdenv.lib.licenses.mit;
 }
diff --git a/src/Main.hs b/src/Main.hs
index e480f4b..96e3fef 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -100,7 +100,7 @@ setFocus = withArg $ \ident -> gFocus .= Just ident
 remove :: Sh GameState ()
 remove = withFocus $ \ident -> do
   name <- toName ident
-  confirmation <- askBool ("Are you sure you want to remove ‘" ++ name ++ "’? ") False
+  confirmation <- askBool ("Are you sure you want to remove ‘" ++ name ++ "’?") False
   when confirmation $ do
     gEntities %= Map.delete ident
     gEntityNames %= Bimap.delete ident
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index aea853d..32f8239 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings #-}
 
 module Sequence.Utils
   ( withArg, withFocus
-  , askBool
+  , askQ, askBool
   , toName, fromName
   ) where
 
@@ -10,6 +10,7 @@ import Sequence.Types
 
 import Control.Monad.State.Strict
 
+import Control.Monad
 import Control.Lens
 
 import Data.Bimap (Bimap)
@@ -32,6 +33,8 @@ import System.Console.Shell
 import System.Console.Shell.ShellMonad
 import System.Console.Shell.Backend.Haskeline
 
+import System.Console.Readline (readline)
+
 
 class Argument a st | a -> st where
   arg :: String -> Sh st (Maybe a)
@@ -47,12 +50,17 @@ withFocus f = use gFocus >>= \focus -> case focus of
   Just id -> f id
 
 askBool :: String -> Bool -> Sh st Bool
-askBool prompt initial = liftIO $ runShell (initialShellDescription { shellCommands = [cmd "y" yes "yes", cmd "n" no "no"], commandStyle = SingleCharCommands, prompt = const $ return prompt, historyEnabled = False }) haskelineBackend initial
+askBool prompt initial = askQ prompt $ fromMaybe initial . join . fmap (eval . CI.mk)
   where
-    yes, no :: Sh Bool ()
-    yes = put True
-    no  = put False
-
+    eval "yes" = Just True
+    eval "y" = Just True
+    eval "no" = Just False
+    eval "n" = Just False
+    eval _ = Nothing
+
+askQ :: String -> (Maybe String -> a) -> Sh st a
+askQ prompt eval = eval <$> liftIO (readline $ prompt ++ " ")
+  
 unaligned = view faction' def
   
 toName :: MonadState GameState m => EntityIdentifier -> m String