Forgot the DbComment module.

Not sure at the moment how to weave that into the storyline for level05
and added some more explanation for level06

level05/src/FirstApp/DB.hs

@@ -74,6 +74,9 @@ initDb fp tab =
     createTableQ = withTable tab
       "CREATE TABLE IF NOT EXISTS $$tablename$$ (id INTEGER PRIMARY KEY, topic TEXT, comment TEXT, time INTEGER)"
 
+-- Note that we don't store the Comment type in the DB, it is the type we build to
+-- send to the outside world. We will be loading our `DbComment` type from the
+-- FirstApp.DB.Types module before converting trying to convert it to a Comment.
 getComments
   :: FirstAppDB
   -> Topic

level05/src/FirstApp/Types/DB.hs

@@ -10,21 +10,11 @@ import           Database.SQLite.Simple.FromRow (FromRow (..), field)
 -- store in the database. In this instance, it is the raw types that make up a
 -- comment.
 data DbComment = DbComment
-  { dbCommentId      :: Int
-  , dbCommentTopic   :: Text
-  , dbCommentComment :: Text
-  , dbCommentTime    :: UTCTime
-  }
   deriving Show
 
--- This type class instance comes from our DB package and tells the DB package
+-- This typeclass instance comes from our DB package and tells the DB package
 -- how to decode a single row from the database into a single representation of
 -- our type. This technique of translating a result row to a type will differ
 -- between different packages/databases.
 instance FromRow DbComment where
   fromRow = DbComment
-            -- field :: FromField a => RowParser a 
-            <$> field
-            <*> field
-            <*> field
-            <*> field

level06/src/FirstApp/AppM.hs

@@ -24,11 +24,6 @@ import           FirstApp.DB            (FirstAppDB)
 -- will add a general purpose logging function, since we're not limited to
 -- just values!
 data Env = Env
-  -- Add the type signature of a very general "logging" function.
-  -- { loggingRick :: Text -> AppM ()
-  -- , envConfig   :: Conf
-  -- , envDb       :: FirstAppDB
-  -- }
 
 -- Lets crack on and define a newtype wrapper for our ReaderT, this will save us
 -- having to write out the full ReaderT definition for every function that uses it.
@@ -40,19 +35,19 @@ newtype AppM a = AppM
   -- different ReaderT when we meant to use our own, or vice versa. In such a
   -- situation it is extremely unlikely the application would compile at all,
   -- but the name differences alone make the confusion a little less likely.
-  -- { unAppM :: ReaderT Env IO a }
+  --
   -- Because we're using a newtype, all of the instance definitions for ReaderT
   -- would normally not apply. However, because we've done nothing but create a
   -- convenience wrapper for our ReaderT, there is an extension for Haskell that
   -- allows it to simply extend all the existing instances to work without AppM.
   -- Add the GeneralizedNewtypeDeriving pragma to the top of the file and these
   -- all work without any extra effort.
-  -- deriving ( Functor
-  --          , Applicative
-  --          , Monad
-  --          , MonadReader Env
-  --          , MonadIO
-  --          )
+  deriving ( Functor
+           , Applicative
+           , Monad
+           , MonadReader Env
+           , MonadIO
+           )
 
 -- This a helper function that will take the requirements for our ReaderT, an
 -- Env, and the (AppM a) that is the context/action to be run with the given Env.
@@ -79,4 +74,3 @@ runAppM
   -> IO a
 runAppM env appM =
   error "runAppM not implemented"
-  -- runReaderT (unAppM appM) env

level06/src/FirstApp/Conf.hs

@@ -34,10 +34,6 @@ import           Text.Read                  (readEither)
 
 import           FirstApp.DB                (Table (..))
 
-{-|
-Similar to when we were considering what might go wrong with the RqTypes, lets
-think about might go wrong when trying to gather our configuration information.
--}
 data ConfigError
   = MissingPort
   | MissingHelloMsg
@@ -45,10 +41,6 @@ data ConfigError
   | MissingDbFilePath
   deriving Show
 
-{-|
-As before, a bare Int or ByteString doesn't tell us anything about our intent,
-so lets wrap it up in a newtype.
--}
 newtype Port = Port
   { getPort :: Int }
   deriving Show
@@ -73,11 +65,6 @@ mkMessage =
   . getHelloMsg
   . helloMsg
 
-{-|
-This will be our configuration value, eventually it may contain more things
-but this will do for now. We will have a customisable port number, and a
-changeable message for our users.
--}
 data Conf = Conf
   { port       :: Port
   , helloMsg   :: HelloMsg
@@ -85,33 +72,6 @@ data Conf = Conf
   , dbFilePath :: FilePath
   }
 
-{-|
-Our application will be able to have configuration from both a file and from
-command line input. We can use the command line to temporarily override the
-configuration from our file. But how to combine them? This question will help us
-find which abstraction is correct for our needs...
-
-We want the CommandLine configuration to override the File configuration, so if
-we think about combining each of our config records, we want to be able to write
-something like this:
-
-defaults <> file <> commandLine
-
-The commandLine should override any options it has input for.
-
-We can use the Monoid typeclass to handle combining the config records together,
-and the Last newtype to wrap up our values. The Last newtype is a wrapper for
-Maybe that when used with its Monoid instance will always preference the last
-Just value that it has:
-
-Last (Just 3) <> Last (Just 1) = Last (Just 1)
-Last Nothing  <> Last (Just 1) = Last (Just 1)
-Last (Just 1) <> Last Nothing  = Last (Just 1)
-
-To make this easier, we'll make a new record PartialConf that will have our Last
-wrapped values. We can then define a Monoid instance for it and have our Conf be
-a known good configuration.
--}
 data PartialConf = PartialConf
   { pcPort       :: Last Port
   , pcHelloMsg   :: Last HelloMsg
@@ -119,15 +79,6 @@ data PartialConf = PartialConf
   , pcDbFilePath :: Last FilePath
   }
 
-{-|
-We now define our Monoid instance for PartialConf. Allowing us to define our
-always empty configuration, which would always fail our requirements. More
-interestingly, we define our mappend function to lean on the Monoid instance for
-Last to always get the last value.
-
-Note that the types won't be able to completely save you here, if you mess up
-the ordering of your 'a' and 'b' you will not end up with the desired result.
--}
 instance Monoid PartialConf where
   mempty = PartialConf mempty mempty mempty mempty
 
@@ -170,8 +121,6 @@ makeConfig pc = Conf
 -- This is the function we'll actually export for building our configuration.
 -- Since it wraps all our efforts to read information from the command line, and
 -- the file, before combining it all and returning the required information.
---
--- Additional Exercise: Rewrite this using applicative style.
 parseOptions
   :: FilePath
   -> IO (Either ConfigError Conf)
@@ -182,11 +131,6 @@ parseOptions fp = do
 
 -- | File Parsing
 
--- Avoiding too many complications with selecting a configuration file package
--- from hackage. We'll use an encoding that you are probably familiar with, for
--- better or worse, and write a small parser to pull out the bits we need.
---
--- Additional Exercise: Rewrite this without using Do notation, fmap should be sufficient.
 parseJSONConfigFile
   :: FilePath
   -> IO PartialConf
@@ -225,9 +169,6 @@ parseJSONConfigFile fp = do
 
 -- | Command Line Parsing
 
--- We will use the optparse-applicative package to build our command line
--- parser, as this problem is fraught with silly dangers and we appreciate
--- someone else having eaten this gremlin on our behalf.
 commandLineParser
   :: ParserInfo PartialConf
 commandLineParser =
@@ -243,15 +184,9 @@ partialConfParser
 partialConfParser = PartialConf
   <$> portParser
   <*> strParse helloFromStr helloMods
-  -- Add our two new fields to the parsing of the PartialConf record. Note that
-  -- if you update the data structure the compiler will do its best to inform
-  -- you about everywhere that needs attention.
   <*> strParse ( Table . Text.pack ) tableMods
   <*> strParse id dbFilePathMods
   where
-    -- With the addition of two new very similar parsers, we can abstract out
-    -- part of the construction into a separate function so we avoid repeating
-    -- ourselves.
     strParse c m =
       Last <$> optional (c <$> strOption m)
 

level06/src/FirstApp/DB.hs

@@ -23,7 +23,6 @@ import           Database.SQLite.SimpleErrors.Types (SQLiteResponse)
 
 import           FirstApp.Types
 
--- newtype all the things!!
 newtype Table = Table
   { getTableName :: Text }
   deriving Show

level06/src/FirstApp/Main.hs

@@ -94,7 +94,7 @@ app env rq cb =
     -- within our AppM context, we need to run the AppM to get our IO action out
     -- to be run and handed off to the callback function. We've already written
     -- the function for this so include the 'runAppM' with the Env.
-    requestToResponse = runAppM env $ do
+    requestToResponse = _f env $ do
       -- Exercise: Rewrite this function to remove the need for the intermediate values.
       rq' <- mkRequest rq
       er' <- handleRErr rq'

level06/src/FirstApp/Types.hs

@@ -33,14 +33,6 @@ import           Data.Time                          (UTCTime)
 import           Database.SQLite.SimpleErrors.Types (SQLiteResponse)
 import           FirstApp.Types.DB                  (DbComment (..))
 
-{-|
-In Haskell the `newtype` comes with zero runtime cost. It is purely used for
-typechecking. So when you have a bare 'primitive' value, like an Int, String, or
-even [a], you can wrap it up in a `newtype` for clarity.
-
-The type system will check it for you, and the compiler will eliminate the cost
-once it has passed.
--}
 newtype CommentId = CommentId Int
   deriving (Show, ToJSON)
 
@@ -50,12 +42,6 @@ newtype Topic = Topic { getTopic :: Text }
 newtype CommentText = CommentText { getCommentText :: Text }
   deriving (Show, ToJSON)
 
--- This is our comment record that we will be sending to users, it's a simple
--- record type. However notice that we've also derived the Generic type class
--- instance as well. This saves us some effort when it comes to creating
--- encoding/decoding instances. Since our types are all simple types at the end
--- of the day, we're able to just let GHC work out what the instances should be.
--- With a minor adjustment.
 data Comment = Comment
   { commentId    :: CommentId
   , commentTopic :: Topic
@@ -95,7 +81,7 @@ fromDbComment dbc =
   Comment (CommentId     $ dbCommentId dbc)
       <$> (mkTopic       $ dbCommentTopic dbc)
       <*> (mkCommentText $ dbCommentComment dbc)
-      <*> pure            (dbCommentTime dbc)
+      <*> (pure          $ dbCommentTime dbc)
 
 -- Having specialised constructor functions for the newtypes allows you to set
 -- restrictions for your newtype.
@@ -124,14 +110,6 @@ data RqType
   | 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 useful to be able to be descriptive about what went wrong.
-
-So lets think about some of the basic things that can wrong with our
-program and create some values to represent that.
--}
 data Error
   = UnknownRoute
   | EmptyCommentText
@@ -146,12 +124,8 @@ data ContentType
   = PlainText
   | JSON
 
--- The ContentType description for a header doesn't match our data definition
--- so we write a little helper function to pattern match on our ContentType
--- value and provide the correct header value.
 renderContentType
   :: ContentType
   -> ByteString
--- renderContentType = error "renderContentType not implemented"
 renderContentType PlainText = "text/plain"
 renderContentType JSON      = "text/json"

level06/tests/Test.hs

@@ -26,15 +26,10 @@ main = do
     Right env -> do
       let app' = pure ( Main.app env )
 
+          -- Write a function to clear the comments for a specific topic.
+          -- This will be run before each test is run.
           flushTopic =
             error "Flush topic not implemented"
-            -- Clean up and yell about our errors
-            -- fmap ( either dieWith pure . join ) .
-            -- Purge all of the comments for this topic for our tests
-            -- traverse ( DB.deleteTopic (AppM.envDb env) )
-            -- We don't export the constructor so even for known values we have
-            -- to play by the rules. There is no - "Oh just this one time.", do it right.
-            -- $ Types.mkTopic "fudge"
 
       -- Run the tests with a DB topic flush between each spec
       hspec . with ( flushTopic >> app' ) $ do