src/Sequence/Utils/Ask.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
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 ++ " ")