From 1ce56dcb0c452ac0aa4fa9e8942479aa7befd412 Mon Sep 17 00:00:00 2001 From: Sean Chalmers Date: Fri, 14 Dec 2018 13:15:08 +1000 Subject: [PATCH] Pin nixpkgs Reorder the modules in level04 to make the order more clear. Add explicit exports to the AppM modules in 5,6, and 7 to help make it clearer that you don't need to use the explicit constructors. Update type signatures for config file functions in level 6 to use the newly generalised AppM to take advantage of the variable error type. --- shell.nix | 20 ++++++++++++++------ src/Level04/README.md | 10 +++++----- src/Level05/AppM.hs | 6 +++++- src/Level06/AppM.hs | 27 +++++++++++++++++++++------ src/Level06/Conf.hs | 2 +- src/Level06/Conf/File.hs | 5 +++-- src/Level07/AppM.hs | 8 +++++++- src/Level07/Core.hs | 5 +++-- 8 files changed, 59 insertions(+), 24 deletions(-) diff --git a/shell.nix b/shell.nix index da37f43..c5d27ab 100644 --- a/shell.nix +++ b/shell.nix @@ -1,20 +1,28 @@ -{ nixpkgs ? import {} -, compiler ? "default" +{ compiler ? "default" }: let - inherit (nixpkgs) pkgs; + inherit (import {}) fetchFromGitHub; + + nixpkgs = fetchFromGitHub { + owner = "NixOS"; + repo = "nixpkgs-channels"; + rev = "4f3446f29910d21eb0fb942bd03091b089cdad63"; + sha256 = "0dqjkhhhckp881mns69qxn4dngcykal1gqrpaf9qy2vja4i41ay5"; + }; + + pkgs = import nixpkgs {}; # Grab our course derivation - course = import ./. { inherit nixpkgs compiler; }; + course = import ./. { nixpkgs = pkgs; inherit compiler; }; # Override the basic derivation so we can have a more fully feature # environment for hacking on the course material courseDevEnv = (pkgs.haskell.lib.addBuildTools course [ # Include the SQLite Database application - nixpkgs.sqlite + pkgs.sqlite # 'ghcid' auto reloading tool - nixpkgs.haskellPackages.ghcid + pkgs.haskellPackages.ghcid ] # We don't want nix to build the thing, we want the environment so we can # build the thing. diff --git a/src/Level04/README.md b/src/Level04/README.md index e8effec..0e819e8 100644 --- a/src/Level04/README.md +++ b/src/Level04/README.md @@ -65,11 +65,11 @@ function into the module scope. ## Steps for this level: The steps for this level: -1) ``src/Level04/DB/Types.hs`` -2) ``src/Level04/DB.hs`` -3) ``src/Level04/Types/Topic.hs`` -4) ``src/Level04/Types/CommentText.hs`` -5) ``src/Level04/Types.hs`` +1) ``src/Level04/Types/Topic.hs`` +2) ``src/Level04/Types/CommentText.hs`` +3) ``src/Level04/DB/Types.hs`` +4) ``src/Level04/Types.hs`` +5) ``src/Level04/DB.hs`` 6) ``src/Level04/Core.hs`` For the sake of simplicity, any configuration requirements will be hardcoded in diff --git a/src/Level05/AppM.hs b/src/Level05/AppM.hs index e3c2c12..e90a9e1 100644 --- a/src/Level05/AppM.hs +++ b/src/Level05/AppM.hs @@ -1,7 +1,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Level05.AppM where +module Level05.AppM + ( AppM + , liftEither + , runAppM + ) where import Control.Monad.Except (MonadError (..)) import Control.Monad.IO.Class (MonadIO (..)) diff --git a/src/Level06/AppM.hs b/src/Level06/AppM.hs index 6eba9cb..90e7220 100644 --- a/src/Level06/AppM.hs +++ b/src/Level06/AppM.hs @@ -1,14 +1,22 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Level06.AppM where +module Level06.AppM + ( AppM + , App + , liftEither + , runAppM + , runApp + ) where import Control.Monad.Except (MonadError (..)) import Control.Monad.IO.Class (MonadIO (..)) +import Data.Bifunctor (Bifunctor (..)) + import Level06.Types (Error) --- | We're going to upgrade the capability of our AppM by generalising the type of the errors that +-- We're going to upgrade the capability of our AppM by generalising the type of the errors that -- it handles. This means that we'll be able to reuse our 'AppM' in more places that maybe have an -- overabundance of 'IO (Either e a)' types. -- @@ -19,20 +27,20 @@ newtype AppM e a = AppM { runAppM :: IO (Either e a) } --- | Predominantly our application has only one error type: 'Error'. It would be tedious to have to +-- Predominantly our application has only one error type: 'Error'. It would be tedious to have to -- declare that on every signature. We're able to use a type _alias_ to avoid this problem. We can -- define this type alias to make the error type variable concrete as 'Error'. -- type App = AppM Error --- | We need to refactor the 'runAppM' function as now the name conflicts, and it needs to suit the +-- We need to refactor the 'runAppM' function as now the name conflicts, and it needs to suit the -- specialised 'App' type. The definition is even simpler than before. If someone near you is up to -- the same section, try to explain to each other why this works. -- runApp :: App a -> IO (Either Error a) runApp = runAppM --- | You may copy your previously completed AppM instances here and then refactor them to suit the +-- You may copy your previously completed AppM instances here and then refactor them to suit the -- more generalised type of AppM. -- | ----------------------------------------------------------------------------------------------- @@ -68,7 +76,14 @@ instance MonadError e (AppM e) where catchError :: AppM e a -> (e -> AppM e a) -> AppM e a catchError = error "catchError for (AppM e) not implemented" --- This is a helper function that will `lift` an Either value into our new AppM +-- The 'Bifunctor' instance for 'Either' has proved useful several times +-- already. Now that our 'AppM' exposes both type variables that are used in our +-- 'Either', we can define a Bifunctor instance and reap similar benefits. +instance Bifunctor AppM where + bimap :: (e -> d) -> (a -> b) -> AppM e a -> AppM d b + bimap = error "bimap for AppM not implemented" + +-- This is a helper function that will `lift` an Either value into our new AppM -- by applying `throwError` to the Left value, and using `pure` to lift the -- Right value into the AppM. -- diff --git a/src/Level06/Conf.hs b/src/Level06/Conf.hs index fa8d4eb..129816f 100644 --- a/src/Level06/Conf.hs +++ b/src/Level06/Conf.hs @@ -46,7 +46,7 @@ makeConfig = -- parseOptions :: FilePath - -> IO (Either ConfigError Conf) + -> AppM ConfigError Conf parseOptions = -- Parse the options from the config file: "files/appconfig.json" -- Parse the options from the commandline using 'commandLineParser' diff --git a/src/Level06/Conf/File.hs b/src/Level06/Conf/File.hs index b034853..472d48d 100644 --- a/src/Level06/Conf/File.hs +++ b/src/Level06/Conf/File.hs @@ -16,6 +16,7 @@ import Waargonaut (Json, parseWaargonaut) import qualified Waargonaut.Decode as D import Waargonaut.Decode.Error (DecodeError (ParseFailed)) +import Level06.AppM (AppM) import Level06.Types (ConfigError (BadConfFile), PartialConf (PartialConf)) -- $setup @@ -33,7 +34,7 @@ import Level06.Types (ConfigError (BadConfFile), -- readConfFile :: FilePath - -> IO (Either ConfigError ByteString) + -> AppM ConfigError ByteString readConfFile = error "readConfFile not implemented" @@ -41,7 +42,7 @@ readConfFile = -- and construct our ``PartialConf``. parseJSONConfigFile :: FilePath - -> IO (Either ConfigError PartialConf) + -> AppM ConfigError PartialConf parseJSONConfigFile = error "parseJSONConfigFile not implemented" where diff --git a/src/Level07/AppM.hs b/src/Level07/AppM.hs index 423cc68..c294cd9 100644 --- a/src/Level07/AppM.hs +++ b/src/Level07/AppM.hs @@ -2,7 +2,13 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Level07.AppM where +module Level07.AppM + ( AppM (..) + , App + , Env (..) + , liftEither + , runApp + ) where import Control.Monad.Except (MonadError (..)) import Control.Monad.IO.Class (MonadIO (..)) diff --git a/src/Level07/Core.hs b/src/Level07/Core.hs index 42d5f62..9e6a5d4 100644 --- a/src/Level07/Core.hs +++ b/src/Level07/Core.hs @@ -69,8 +69,9 @@ runApplication = do runWithDBConn env = appWithDB env >> DB.closeDB (envDB env) - appWithDB env = - Ex.finally (run ( confPortToWai $ envConfig env ) (app env)) (DB.closeDB (envDB env)) + appWithDB env = Ex.finally + (run ( confPortToWai . envConfig $ env ) (app env)) + $ DB.closeDB (envDB env) -- | Our AppM is no longer useful for implementing this function. Can you explain why? --