mirror of
https://github.com/qfpl/applied-fp-course.git
synced 2024-11-26 06:38:40 +03:00
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.
This commit is contained in:
parent
b8921cd1aa
commit
1ce56dcb0c
20
shell.nix
20
shell.nix
@ -1,20 +1,28 @@
|
||||
{ nixpkgs ? import <nixpkgs> {}
|
||||
, compiler ? "default"
|
||||
{ compiler ? "default"
|
||||
}:
|
||||
let
|
||||
inherit (nixpkgs) pkgs;
|
||||
inherit (import <nixpkgs> {}) 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.
|
||||
|
@ -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
|
||||
|
@ -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 (..))
|
||||
|
@ -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,6 +76,13 @@ 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"
|
||||
|
||||
-- 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.
|
||||
|
@ -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'
|
||||
|
@ -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
|
||||
|
@ -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 (..))
|
||||
|
@ -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?
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user