From cfb7be14aebffd68ca357d7c6ef15e1c0974a156 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 3 Jun 2016 22:09:01 +0200
Subject: cleanup & stumped on variadic val

---
 src/Sequence/Utils/Ask.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 src/Sequence/Utils/Ask.hs

(limited to 'src/Sequence/Utils')

diff --git a/src/Sequence/Utils/Ask.hs b/src/Sequence/Utils/Ask.hs
new file mode 100644
index 0000000..8020656
--- /dev/null
+++ b/src/Sequence/Utils/Ask.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Sequence.Utils.Ask
+  ( askQ, askBool
+  ) where
+
+import System.Console.Readline (readline)
+
+import Control.Monad.IO.Class
+import Control.Monad
+
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
+
+import Data.Maybe
+
+askBool :: MonadIO m => String -> Bool -> m Bool
+askBool prompt initial = askQ prompt $ fromMaybe initial . join . fmap (eval . CI.mk)
+  where
+    eval "yes" = Just True
+    eval "y" = Just True
+    eval "no" = Just False
+    eval "n" = Just False
+    eval _ = Nothing
+
+askQ :: MonadIO m => String -> (Maybe String -> a) -> m a
+askQ prompt eval = eval <$> liftIO (readline $ prompt ++ " ")
-- 
cgit v1.2.3