Application.hs

{-# LANGUAGE RecordWildCards #-}

module Test.Tutorial.Application where

import qualified Data.ByteString.Char8 as BS8
import           Data.Text.Encoding    (decodeUtf8)
import           Protolude
import           System.Directory      (doesFileExist)
import           System.Random

data App = App {
  userInput    :: UserInput IO
, secretReader :: SecretReader IO
, rng          :: Rng IO
, console      :: Console IO
}

startApp :: App -> IO ()
startApp app@App{..} = do
  userAnswer <- askQuestion userInput
  continue <-
    case userAnswer of
      Maybe -> randomBool rng
      No    -> pure False
      Yes   -> pure True

  if continue then
    do secret <- readSecret secretReader
       case secret of
         Nothing -> write console "Sorry I actually don't know"
         Just s -> do
           write console ("the answer is " <> s)
           startApp app
  else
    write console "bye"

data Logger m = Logger {
  info  :: Text -> m ()
, error :: Text -> m ()
}

newLogger :: Logger IO
newLogger = Logger {
  info  = \t -> print $ "[INFO] " <> t
, error = \t -> print $ "[ERROR] " <> t
}

data UserAnswer = Yes | No | Maybe deriving (Eq, Show)

data UserInput m = UserInput {
  askQuestion :: m UserAnswer
}

newUserInput :: Console IO -> UserInput IO
newUserInput console =
  let userInput = UserInput {
        askQuestion = do
          write console "Do you want to know the answer to Life, the Universe and Everything? (Yes/No/Maybe)"
          answer <- read console
          case answer of
            "Yes"   -> pure Yes
            "No"    -> pure No
            "Maybe" -> pure Maybe
            _       -> write console "Please enter Yes, No or Maybe" >> askQuestion userInput
      }
   in userInput

data Rng m = Rng {
  randomBool :: m Bool
}

newRng :: Logger IO -> Rng IO
newRng logger = Rng {
  randomBool = do
    b <- randomIO
    info logger ("generated a random boolean " <> show b)
    pure b
}

-- Get the secret answer and return Nothing if not found
data SecretReader m = SecretReader {
  readSecret :: m (Maybe Text)
}

data SecretReaderConfig = SecretReaderConfig Text deriving (Eq, Show)

newSecretReader :: SecretReaderConfig -> Logger IO -> SecretReader IO
newSecretReader (SecretReaderConfig path) logger = SecretReader {
  readSecret = do
    exists <- doesFileExist (toS path)
    if exists then Just . decodeUtf8 <$> BS8.readFile (toS path)
    else error logger ("file does not exist at " <> path) $> Nothing
}

data Console m = Console {
  write :: Text -> m ()
, read  :: m Text
}

newConsole :: Console IO
newConsole = Console putStrLn (toS <$> getLine)