[#9] Implement Yes/No reading functions (#117)

* Add tests (mainly)

* Add Changelog

* Remove unnecessary changes (store handle in env)

* fix formatting

* fix more formatting (test)

* PR fixes

* Update test/Test/Iris/Interactive/Question.hs

Co-authored-by: Dmitrii Kovanikov <[email protected]>

* test recactoring and changelog fixed

---------

Co-authored-by: Dmitrii Kovanikov <[email protected]>

CHANGELOG.md

@@ -10,6 +10,15 @@ available [on GitHub][2].
 
 <!-- Add new changes here -->
 
+### Added 
+[#9](https://github.com/chshersh/iris/issues/9):
+Implement Yes/No reading functions:
+
+  * Add `yesno` function for asking a question with can be answered with either Yes or No
+  * Add `YesNo` type (`Yes` | `No`)
+
+  (by [@martinhelmer])
+
 ## [0.1.0.0] — 2023-03-02 🎂
 
 ### Added
@@ -130,6 +139,7 @@ Initial release prepared by [@chshersh].
 [@himanshumalviya15]: https://github.com/himanshumalviya15
 [@lillycat332]: https://github.com/lillycat332
 [@marcellourbani]: https://github.com/marcellourbani
+[@martinhelmer]: https://github.com/martinhelmer
 [@zetkez]: https://github.com/zetkez
 
 <!-- Header links -->

iris.cabal

@@ -94,6 +94,9 @@ library
       Iris.Env
       Iris.Settings
       Iris.Tool
+      Iris.Interactive 
+        Iris.Interactive.Question 
+
 
   build-depends:
     , ansi-terminal        ^>= 0.11
@@ -121,6 +124,8 @@ test-suite iris-test
       Test.Iris.Colour
         Test.Iris.Colour.Mode
       Test.Iris.Tool
+      Test.Iris.Interactive
+        Test.Iris.Interactive.Question
 
   build-depends:
     , iris

src/Iris.hs

@@ -48,13 +48,15 @@ module Iris (
     module Iris.Settings,
     -- $tool
     module Iris.Tool,
+    module Iris.Interactive,
 ) where
 
 import Iris.App
 import Iris.Browse
 import Iris.Cli
 import Iris.Colour
 import Iris.Env
+import Iris.Interactive
 import Iris.Settings
 import Iris.Tool
 

src/Iris/Interactive.hs

@@ -0,0 +1,22 @@
+{- |
+Module                  : Iris.Interactive
+Copyright               : (c) 2023 Dmitrii Kovanikov
+SPDX-License-Identifier : MPL-2.0
+Maintainer              : Dmitrii Kovanikov <[email protected]>
+Stability               : Experimental
+Portability             : Portable
+
+Functions to handle interactive mode.
+
+@since x.x.x.x
+-}
+module Iris.Interactive (
+    -- $question
+    module Iris.Interactive.Question,
+) where
+
+import Iris.Interactive.Question
+
+{- $question
+Asking Questions and receiving an answer:
+-}

src/Iris/Interactive/Question.hs

@@ -0,0 +1,118 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+{- |
+Module                  : Iris.Interactive.Question
+Copyright               : (c) 2023 Dmitrii Kovanikov
+SPDX-License-Identifier : MPL-2.0
+Maintainer              : Dmitrii Kovanikov <[email protected]>
+Stability               : Experimental
+Portability             : Portable
+
+Asking Questions. Receiving answers.
+
+@since x.x.x.x
+-}
+module Iris.Interactive.Question (
+    yesno,
+    YesNo (..),
+    parseYesNo,
+) where
+
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Reader (MonadReader)
+
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+import System.IO (hFlush, stdout)
+
+import Iris.Cli.Interactive (InteractiveMode (..))
+import Iris.Env (CliEnv (..), asksCliEnv)
+
+{-
+@since x.x.x.x
+-}
+parseYesNo :: Text -> Maybe YesNo
+parseYesNo t = case Text.toUpper . Text.strip $ t of
+    "Y" -> Just Yes
+    "YES" -> Just Yes
+    "YS" -> Just Yes
+    "N" -> Just No
+    "NO" -> Just No
+    _ -> Nothing
+
+{- | Parsed as Yes: "Y", "YES", "YS" (lower- or uppercase)
+
+Parsed as No: "N", "NO" (lower- or uppercase)
+
+@since x.x.x.x
+-}
+data YesNo
+    = No
+    | Yes
+    deriving stock
+        ( Show
+          -- ^ @since x.x.x.x
+        , Eq
+          -- ^ @since x.x.x.x
+        , Ord
+          -- ^ @since x.x.x.x
+        , Enum
+          -- ^ @since x.x.x.x
+        , Bounded
+          -- ^ @since x.x.x.x
+        )
+
+{- | Ask a yes/no question to stdout, read the reply from terminal, return an Answer.
+
+In case of running non-interactively, return the provided default
+
+Example usage:
+
+@
+app :: App ()
+app = do
+    answer <- Iris.yesno "Would you like to proceed?" Iris.Yes
+    case answer of
+        Iris.Yes -> proceed
+        Iris.No -> Iris.outLn "Aborting"
+
+
+\$ ./irisapp
+Would you like to proceed? (yes/no)
+I don't understand your answer: ''
+Please, answer yes or no (or y, or n)
+Would you like to proceed? (yes/no) ne
+I don't understand your answer: 'ne'
+Please, answer yes or no (or y, or n)
+Would you like to proceed? (yes/no) NO
+Aborting
+
+@
+
+@since x.x.x.x
+-}
+yesno
+    :: (MonadIO m, MonadReader (CliEnv cmd appEnv) m)
+    => Text
+    -- ^ Question Text
+    -> YesNo
+    -- ^ Default answer when @--no-input@ is provided
+    -> m YesNo
+yesno question defaultAnswer = do
+    interactiveMode <- asksCliEnv cliEnvInteractiveMode
+    case interactiveMode of
+        NonInteractive -> pure defaultAnswer
+        Interactive -> liftIO loop
+  where
+    loop :: IO YesNo
+    loop = do
+        Text.putStr $ question <> " (yes/no) "
+        hFlush stdout
+        input <- Text.getLine
+        case parseYesNo input of
+            Just answer -> pure answer
+            Nothing -> do
+                Text.putStrLn $ "I don't understand your answer: '" <> input <> "'"
+                Text.putStrLn "Please, answer yes or no (or y, or n)"
+                loop

test/Test/Iris.hs

@@ -4,6 +4,7 @@ import Test.Hspec (Spec, describe)
 
 import Test.Iris.Cli (cliSpec, cliSpecParserConflicts)
 import Test.Iris.Colour (colourSpec)
+import Test.Iris.Interactive (interactiveSpec)
 import Test.Iris.Tool (toolSpec)
 
 irisSpec :: Spec
@@ -12,3 +13,4 @@ irisSpec = describe "Iris" $ do
     cliSpecParserConflicts
     colourSpec
     toolSpec
+    interactiveSpec

test/Test/Iris/Interactive.hs

@@ -0,0 +1,9 @@
+module Test.Iris.Interactive (interactiveSpec) where
+
+import Test.Hspec (Spec, describe)
+
+import Test.Iris.Interactive.Question (questionSpec)
+
+interactiveSpec :: Spec
+interactiveSpec = describe "Interactive" $ do
+    questionSpec

test/Test/Iris/Interactive/Question.hs

@@ -0,0 +1,34 @@
+module Test.Iris.Interactive.Question (questionSpec) where
+
+import Control.Monad (forM_)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Test.Hspec (Spec, SpecWith, describe, it, shouldBe)
+
+import Iris.Interactive.Question (
+    -- under test
+    YesNo (..),
+    parseYesNo,
+ )
+
+yesAnswers :: [Text]
+yesAnswers = "y" : "Y" : [y <> e <> s | y <- ["y", "Y"], e <- ["e", "E", ""], s <- ["s", "S"]]
+
+questionSpec :: Spec
+questionSpec =
+    describe "Question - parse YesNo" $ do
+        checkElements yesAnswers (Just Yes)
+        checkElements ["n", "N", "NO", "no", "No", "nO"] (Just No)
+        checkElements ["a", "ye", "NOone", "yesterday", "oui"] Nothing
+        it "Empty string parses to Nothing" $
+            parseYesNo "" `shouldBe` Nothing
+
+checkElements
+    :: [Text]
+    -> Maybe YesNo
+    -> SpecWith ()
+checkElements values expected = do
+    describe ("should parse to " ++ show expected) $
+        forM_ values $ \strValue ->
+            it (Text.unpack strValue) $
+                parseYesNo strValue `shouldBe` expected