Application.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

module Test.Tutorial.Application where

import qualified Data.ByteString.Char8 as BS8
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)