From c012a80c57c030bce866116f224cdd7fca4e5d4a Mon Sep 17 00:00:00 2001
From: Fane Bastin <fane.bastin@bellroy.com>
Date: Thu, 24 Mar 2022 10:20:00 +1100
Subject: [PATCH] Finish Level02/Types.hs

---
 src/Level02/Types.hs | 100 +++++++++++++++++++++++--------------------
 1 file changed, 54 insertions(+), 46 deletions(-)

diff --git a/src/Level02/Types.hs b/src/Level02/Types.hs
index 6e531f77..5d2e9a32 100644
--- a/src/Level02/Types.hs
+++ b/src/Level02/Types.hs
@@ -1,20 +1,22 @@
-{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-dodgy-exports #-}
+
 module Level02.Types
-  ( Topic
-  , CommentText
-  , ContentType (..)
-  , RqType (..)
-  , Error (..)
-  , mkTopic
-  , getTopic
-  , mkCommentText
-  , getCommentText
-  , renderContentType
-  ) where
-
-import           Data.ByteString (ByteString)
-import           Data.Text       (Text)
+  ( Topic,
+    CommentText,
+    ContentType (..),
+    RqType (..),
+    Error (..),
+    mkTopic,
+    getTopic,
+    mkCommentText,
+    getCommentText,
+    renderContentType,
+  )
+where
+
+import Data.ByteString (ByteString)
+import Data.Text (Text)
 
 -- Working through the specification for our application, what are the
 -- types of requests we're going to handle?
@@ -44,11 +46,11 @@ import           Data.Text       (Text)
 
 -- Topic
 newtype Topic = Topic Text
-  deriving Show
+  deriving (Show)
 
 -- CommentText
 newtype CommentText = CommentText Text
-  deriving Show
+  deriving (Show)
 
 -- Using these convenient definitions, we can create the following constructors
 -- for our RqType:
@@ -57,6 +59,9 @@ newtype CommentText = CommentText Text
 -- ViewRq : Which needs the topic being requested.
 -- ListRq : Which doesn't need anything and lists all of the current topics.
 data RqType
+  = AddRq Topic CommentText
+  | ViewRq Topic
+  | ListRq
 
 -- Not everything goes according to plan, but it's important that our types
 -- reflect when errors can be introduced into our program. Additionally it's
@@ -64,7 +69,8 @@ data RqType
 
 -- Fill in the error constructors as you need them.
 data Error
-
+  = EmptyTopicError
+  | EmptyCommentTextError
 
 -- Provide the constructors for a sum type to specify the `ContentType` Header,
 -- to be used when we build our Response type. Our application will be simple,
@@ -73,6 +79,8 @@ data Error
 -- - plain text
 -- - json
 data ContentType
+  = PlainText
+  | JSON
 
 -- The ``ContentType`` constructors don't match what is required for the header
 -- information. Because ``wai`` uses a stringly type. So write a function that
@@ -85,11 +93,11 @@ data ContentType
 -- - plain text = "text/plain"
 -- - json       = "application/json"
 --
-renderContentType
-  :: ContentType
-  -> ByteString
-renderContentType =
-  error "renderContentType not implemented"
+renderContentType ::
+  ContentType ->
+  ByteString
+renderContentType PlainText = "text/plain"
+renderContentType JSON = "application/json"
 
 -- We can choose to *not* export the constructor for a data type and instead
 -- provide a function of our own. In our case, we're not interested in empty
@@ -99,28 +107,28 @@ renderContentType =
 -- The export list at the top of this file demonstrates how to export a type,
 -- but not export the constructor.
 
-mkTopic
-  :: Text
-  -> Either Error Topic
-mkTopic =
-  error "mkTopic not implemented"
-
-getTopic
-  :: Topic
-  -> Text
-getTopic =
-  error "getTopic not implemented"
-
-mkCommentText
-  :: Text
-  -> Either Error CommentText
-mkCommentText =
-  error "mkCommentText not implemented"
-
-getCommentText
-  :: CommentText
-  -> Text
-getCommentText =
-  error "getCommentText not implemented"
+mkTopic ::
+  Text ->
+  Either Error Topic
+mkTopic t
+  | t == "" = Left EmptyTopicError
+  | otherwise = Right (Topic t)
+
+getTopic ::
+  Topic ->
+  Text
+getTopic (Topic t) = t
+
+mkCommentText ::
+  Text ->
+  Either Error CommentText
+mkCommentText ct
+  | ct == "" = Left EmptyCommentTextError
+  | otherwise = Right (CommentText ct)
+
+getCommentText ::
+  CommentText ->
+  Text
+getCommentText (CommentText ct) = ct
 
 ---- Go to `src/Level02/Core.hs` next