Luminescent Dreams

Computer Graphics in Haskell

Welcome

Functions

circleArea :: Float -> Float
circleArea r = pi * r ^ 2

rectangleArea :: Float -> Float -> Float
rectangleArea l w = l * w

triangleArea :: Float -> Float -> Float
triangleArea h b = h * b / 2

totalCirclesArea :: [Float] -> Float
totalCirclesArea rs = sum (map circleArea rs)

Function Structure

functionName :: TypeParam1 -> TypeParam2 -> ... -> TypeResult
functionName param1 param2 ... =

Functions

pi :: Float

Functions

not :: Bool -> Bool

not is a function which takes a single parameter (a Boolean) and returns a result (another Boolean).

Functions

(++) :: String -> String -> String

++ is a function which takes one parameter (a String) and returns a new function that takes a single parameter (also a String) and returns a result.

Functions

(++) :: String -> String -> String

> :t (++) "a"
(++) "a" :: String -> String

Functions

(++) :: String -> String -> String

> :t (++) "a" "b"
(++) "a" "b" :: String
> (++) "a" "b"
"ab"

Functions

(++) :: String -> String -> String

> :t (++) "a" "b"
(++) "a" "b" :: String
> (++) "a" "b"
"ab"
> "a" ++ "b"
"ab"

Polymorphism

(++) :: [a] -> [a] -> [a]

++ is a function which takes one parameter (a list of anything) and returns a new function that takes a single parameter (also a list, but of the same thing) and returns a result. ++ works on the list structure and cares nothing for the data contained in the list.

Partial Application and more Polymorphism

map :: (a -> b) -> [a] -> [b]

Map is a function which takes one parameter (itself a function) and returns a new function that takes a single parameter and returns a result.

Partial Application and more Polymorphism

map :: (a -> b) -> [a] -> [b]

> :t map not
map not :: [Bool] -> [Bool]

Partial Application and more Polymorphism

map :: (a -> b) -> [a] -> [b]

> :t map not
map not :: [Bool] -> [Bool]

> :t map not [True, True, False]
map not [True, True, False] :: [Bool]
> map not [True, True, False]
[False,False,True]

Type Constraints

show :: Show a => a -> String

> show 15
"15"

show is a function that takes a value, which must implement the Show interface, and returns a String.

Type Constraints

show :: Show a => a -> String

class Show a where
  show :: a -> String

show is a function that takes a value, which must implement the Show interface, and returns a String.

Building polymorphism

circleArea :: Float -> Float
circleArea r = pi * r ^ 2

rectangleArea :: Float -> Float -> Float
rectangleArea l w = l * w

triangleArea :: Float -> Float -> Float
triangleArea h b = h * b / 2

totalCirclesArea :: [Float] -> Float
totalCirclesArea rs = sum (map circleArea rs)

Building polymorphism

area :: ??? -> Float

totalArea :: [???] -> Float
totalArea shapes = sum (map area shapes)

Defining a data type

  • Int
  • Float
  • String

Defining a data type

data Shape = ...
           deriving (Show)

Defining a data type

data Shape = Circle
           deriving (Show)

Shapes> let a = Circle
Shapes> a
Circle
Shapes> :t a
a :: Shape
Shapes> :t Circle
Circle :: Shape

Add a radius to the Circle

data Shape = Circle Float
           deriving (Show)

Shapes> :t Circle
Circle :: Float -> Shape
Shapes> let a = Circle 15
Shapes> a
Circle
Shapes> :t a
a :: Shape

Python Equivalent

class Shape:
  def __init__ (self, name, *args):
    self.shape = name
    self.args = args

  @classmethod
  def Circle (cls, radius):
    return cls("Circle", radius)

Add a few more shapes

data Shape = Circle Float
           | Rectangle Float Float
           | Triangle Float Float
           deriving (Show)

Shapes> :t Circle 15
Shape
Shapes> :t Rectangle 15.0 16.0
Shape

Python Equivalent

class Shape:
  def __init__ (self, name, *args):
    self.shape = name
    self.args = args

  @classmethod
  def Circle (self, radius):
    return cls("Circle", radius)

  @classmethod
  def Rectangle (self, length, width):
    return cls("Rectangle", length, width)

  @classmethod
  def Triangle (self, height, base):
    return cls("Triangle", height, base)

Destructuring

area :: Shape -> Float
area (Circle ...) = ...
area (Rectangle ...) = ...
area (Triangle ...) = ...

Destructuring

area :: Shape -> Float
area (Circle r) = pi * r ^ 2
area (Rectangle l w) = l * w
area (Triangle b h) = b * h / 2

Destructuring

area :: Shape -> Float
area (Circle r) = pi * r ^ 2
area (Rectangle l w) = l * w
area (Triangle b h) = b * h / 2

totalArea :: [Shape] -> Float
totalArea shapes = sum (map area shapes)

Seen in action

*Shapes> map area [Circle 1, Rectangle 1 1, Triangle 1 1]
[3.1415927,1.0,0.5]
*Shapes> map area [Circle 15, Rectangle 14 20, Triangle 15 16]
[706.85834,280.0,120.0]

Let’s switch to graphics

Gloss

display :: Display -> Color -> Picture -> IO ()

Gloss Pictures

data Picture = Circle Float
             | Polygon Path
             | Blank

display (InWindow "Women Who Code" (200, 200) (10, 10)) black (Circle 80)

Gloss Pictures

data Picture = Circle Float
             | Polygon Path
             | Blank
             | Color Color Picture

display (InWindow "Women Who Code" (200, 200) (10, 10)) black (Color white (Circle 80))

Gloss Pictures

data Picture = Circle Float
             | Polygon Path
             | Blank
             | Color Color Picture
             | Pictures [Picture]

display (InWindow "Women Who Code" (200, 200) (10, 10))
        black
        (Pictures [ Color white (Circle 80)
                  , Color blue (Circle 40)
                  ] )

Gloss Pictures

data Picture = Circle Float
             | Polygon Path
             | Blank
             | Color Color Picture
             | Pictures [Picture]
             | Translate Float Float Picture
             | Rotate Float Picture
             | Scale Float Float Picture

display (InWindow "Women Who Code" (200, 200) (10, 10))
        black
        (Pictures [ Color white (Translate 15 0 (Circle 80))
                  , Color blue (Circle 40)
                  ] )

References

Configuring your Haskell application

One way or another, you are going to need to configure your Haskell application, and for that you have three major ways of doing it. I recommend choosing one and sticking to it. You can choose multiple ones, but it is important that you minimize one of them in order to keep yourself out of the mind-numbing tedium of consistently combining multiple input parameter sets and their overrides.

Your options tend to be…

  • CLI Option parsing

    I recommend this for small utilities, especially those which you are going to run frequently and with a variety of configurations.

  • Configuration files

    This is generally my preferred way of running an application. You’ll still need to do a little bit with option parsing, but only enough to get a configuration. However, it can be a total pain to need to edit a file to change the configuration for a utlity, so use this for your longer-running applications.

  • Environment variables

    This is not generally how I want to configure an application, but some environments, such as Heroku, make it the easiest way.

CLI Option Parsing

The most important rule of parsing options from the CLI is…

*Don't write your own CLI parsing library.*

I have made this mistake. It is no longer on the internet. Do not do what I have done. Do this instead.

For particularly simple parameter parsing, you don’t need any libraries. For example I have a tool that I use on occasion to reformat an m3u playlist for my phone. Rhythmbox exports the playlist in an m3u format, but with all paths that don’t work for my Android phone. A tool like this is so simple that the only parameters to it are the input file and the output file.

In fact, the tool is so simple that it may have been better for me to accept the input data on standard in and emit the output data on standard out. Please forgive me for that, too.
import           System.Environment (getArgs)


main :: IO ()
main = do
    (source:dest:_) <- getArgs

That is the simplest way. However, you may wish to be kind to your users…

main :: IO ()
main = do
    args <- getArgs
    case args of
        (source:dest:_) -> {- do your thing! -}
        _ -> print "Run the application with the source and destination files."

This is your standby for applications with very simple parameters, and these applications are quite common. However, more complex configuration is often needed. For that, resort to Optparse-Applicative. This will give you command line options that are very similar in power to the one available in Go.

The tutorial covers basically everything, but here’s a starter example:

cliParser :: Parser Config
cliParser = Config <$> option auto (long "interval" <> help "number of seconds between samples" <> value 5)
                   <*> strOption (long "log" <> help "log output file")
                   ...

main = do
    Config{..} <- execParser (info (helper <*> cliParser)
                             (fullDesc <> progDesc "description of the program"))

Look here for a summary of the functions and typeclasses involved above. The entire block around execParser is basically boilerplate code, and all of the interesting bits happen inside cliParser.

This technique is as common as mud. As an administrator, I do like to pass parameters to my applications, but I dislike services that require excessively long command lines to run. If your application requires more than four or five parameters, or if the parameters rarely change from one run to the next, look to the next section for configuration files, instead.

Configuration Files

For almost all of my configuration needs, I like to go with a file on the disk. I usually put it into a Yaml format, because that allows some complex nested configurations and saves me from needing to write a configuration parser myself.

For my example, I will demonstrate with a program that I use for my HDR processing toolchain. The program has to go through several steps, and basically it needs these parameters:

  • Do I need to align the photographs?
  • What are my input files?
  • What white balance parameters should I use for developing the files?

and so forth. These are the most important parameters. A typical file looks like this:

wb: camera
project: lake-travis-dam
sources:
- _DSC3656.dng
- _DSC3657.dng
- _DSC3658.dng
- _DSC3659.dng
- _DSC3660.dng
align: false
fanout: false

So, first I want a data structure to store this:

data WhiteBalance = Camera | Auto

data Project = Project {
      sources :: [String]
    , project :: String
    , wb :: WhiteBalance
    , align :: Bool
    , fanout :: Bool
    }
    deriving (Show)


instance Default Project where
    def = Project [] "" Camera False False

(incidentally, I like having defaults for my structures, if I can concieve of a reasonable default)

Whether Yaml or JSON, in Haskell I need a FromJSON instance for parsing this file:

instance FromJSON Project where
    parseJSON (Object obj) =
        Project <$> obj .: "sources"
                <*> obj .: "project"
                <*> obj .: "wb"
                <*> obj .: "align"
                <*> obj .: "fanout"
    parseJSON obj = fail $ show obj

instance FromJSON WhiteBalance where
    parseJSON (String str) =
        case str of
            "camera" -> pure Camera
            "auto" -> pure Auto
            _ -> fail $ "invalid wb string: " ++ T.unpack str
    parseJSON (Object obj) =
        WhiteBalance <$> obj .: "temp"
                     <*> obj .: "green"
    parseJSON obj = fail $ show obj

aside: I use fail instead of mzero or mempty because propogating out any error message at all helps immensely with debugging. I wish I could use throwError, but MonadError is not implemented for Parser.

-- now include code for reading JSON format and Yaml format

Environment Variables

While I do not particularly like using environment variables for configuration an application, Heroku and presumably some other services require their use. On the other hand, most languages treat environment variables as a simple dictionary, making them simple to retrieve. Haskell is no exception to this. The only catch is that nested structures require a little more effort to build.

Your workhorse function is System.Environment.getEnv :: String -> IO String. The function will return the value if present, or throw an IO exception if it is not present. Since you may sometimes want to make the variable optional, so, here is a function that will capture isDoesNotExistError and translate it into a Maybe:

maybeGetEnv :: String -> IO (Maybe String)
maybeGetEnv k = (Just <$> getEnv k) `catch` handleIOExc
    where
    handleIOExc exc
        | isDoesNotExistError exc = pure Nothing
        | otherwise = throw exc

Then write your configuration function like so:

import Data.List.Split (splitOn)

loadConfiguration :: IO Config
loadConfiguration = do
    p <- getEnv "PROJECT_NAME"
    s <- splitOn "," <$> getEnv "SOURCES"
    align <- maybe False read <$> maybeEnv "ALIGN_IMAGES"
    fanout <- maybe False read <$> maybeEnv "FANOUT_EXPOSURES"
    pure $ Config s p Camera align fanout

These are your three major methods for configuring an application. Many applications will permit a certain degree of hybridization between them, but I think it is best to minimize that as much as possible. For instance, a command line parameter to specify the path to a configuration file. Doing it in the general case, handling command line parameters, defaults, configuration options, and environment variables, has typically lead to a very difficult-to-use mess, and I have regretted such attempts.

Whichever method you use for passing configuration in, you’ll then want to wrap that configuration up into a context for your application. I will hint more on that in my next article, on the application monad, and give it significantly more detailed treatment later on.


Questions? Comments? Feedback? Email me. I am particularly interested in places that you feel are unclear or which could use better explanation, or experiments you have run that turned out better.

Creative Commons License
Configuring your Haskell application by Savanni D’Gerinel is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.

CV

Savanni D'Gerinel

512-947-0226
savanni@luminescent-dreams.com

Objective

I seek an engineering leadership position that involves developing reliable, sustainable processes, mentoring junior engineers, fostering collaboration between team members, and building a close relationship with designers and with users.

Prospective companies must be remote-first or interesting in learning distributed working skills, be dedicated to building and maintaining a highly diverse team, willing to invest in the development of all their employees, and practices compassion for users.

An ideal position is a leadership role with a team that uses Rust, Haskell, Typescript, Elm, or Purescript in applications that target existential problems such as climate change, social justice, public health, and user privacy.

Interests

  • Application architecture
  • Native graphical applications
  • Photography
  • Cycling
  • Go

Public Repositories

  • Fitnesstrax
  • Emseries – an embedded time series database for small applications
  • Orizentic – a library for managing JWT-based authentication tokens, available in Haskell, Go, and Rust
  • Palimpsest – a suite of tools to bridge the gaps between standard devops suites
  • Nix Home Environment

Skills

  • Test-driven Development, Object-oriented design, requirements gathering and project management, Agile methodologies.
  • Programming Languages
    • Rust: 2 years, web services and native GTK development on NixOS
    • Haskell: 12 years, including Servant, Scotty, Yesod, Happstack, Heist, Persistent, Esqueleto, and GTK.
    • Standard C: 20 years of experience.
    • Javascript, Typescript, Perl, Clojure, Ocaml, Purescript, Go, Python and Nix
  • Project management familiar with 1 and 2 week sprint cycles, iteration planning meetings, daily standups, and retrospectives.
  • Website Programming: A variety of projects including REST-style and GraphQL-style applications in Python, Haskell, Rust, and Javascript with React and Redux.
  • Databases: MySQL, PostgreSQL, SQLite, Lightcloud with Tokyo Tyrant
  • Devops: Docker, AWS, Terraform, Ansible, Packer, Nix
  • Lecturer in Haskell programming topics

Experience

1Password: June 2020 - current, Technical Lead

Cloud City Development: August 2017 - June 2020, Senior Developer

As a consultant here, I have a changing set of software development responsibilities that include network setup and management, developing and managing automatic upgrades for IoT hardware in the field, developing server software to receive and process data from hardware, and developing web applications.

  • Created policies and automation for replaceable infrastructure using Terraform, reducing operational error and improving service reliability for our client, Truveon. This infrastructure included the tools that allow the developers to deploy recent builds to both staging and production infrastructure without intervention from operations.
  • Built an automated software update system for embedded devices in the field, which maximized the safety of deploying a Python application to embedded devices on a potentially unreliable consumer-grade networks.
  • Led the React and D3 integration and developed the animated display for the innovative open source project TSOMI
  • Provided technical leadership and development for a Ruby on Rails project for Resolve to Save Lives. The application helps countries create a plan for improving their readiness to face public health threats, such as epidemics and radiological events.

CollegeVine: December 2016 - June 2017, Software Engineer

My responsibilities involved server and client-side development in the platform our consultants and clients used to coordinate their activities.

Curb: October 2015 - October 2016, Software Engineer

I was responsible for the entire energy monitoring platform infrastructure, including provisioning, load balancing, disaster recovery and performance.

  • Created policies and automation for replaceable infrastructure using Terraform, reducing operational error and improving service reliability.
  • Automated a zero-downtime software deployment using Ansible on a data ingestion cluster.
  • Built ingestion services capable of handling more than 100 megabits/s of metrics in near-realtime using off-the-shelf components and purpose-specific code developed primarily in Haskell and Python.
  • Build a stand-alone OAuth 2.0 server.

Powerhouse Management: June 2014 - August 2015, Software Engineer

I was the lead developer for add-on service offerings for VyprVPN. I lead the design, project management, and development of the VyprVPN for Business product, which provides a turnkey VPN solution for employees to securely connect to corporate intranets.

  • Coached developers on Python programming with Flask, object oriented design, and automated testing.
  • Developed the early interface for the software using Javascript.
  • Helped lead a collaborative design process yielding the system architecture and development plan for VyprVPN for Business.
  • Conducted agile project management to provide a clear view on how far the project had progressed and how much further it had to go.

EMR Technical Solutions: December 2013 - February 2014

I was the lead developer for a web-based medical billing application. I handled design, task setting, and implementation.

Giganews/Goldenfrog/Powerhouse Management: 2005 - 2013

My role shifted over the years between being the sole developer on several projects and a team contributor in others. I introduced test-driven development, began the practice of frequent code reviews, and set up the practice of morning checkin metings.

  • My work formed the backbone of the entire VyprVPN product, providing nearly all aspects of authentication, connection tracking, and VPN management.
  • Built the DMCA response infrastructure for VyprVPN to help the business comply with the common carrier protections provided by the DMCA.
  • Debugged and maintained the Giganews NNTP news servers, written in C.
  • Wrote a connection and download accounting server, which has been in continuous operation, processing thousands of commands per second, with no failures since its creation, including handling unavailability of its database servers while still responding to requests.
  • Core synchronization engine for the a Dropbox-like cloud storage product.

National Instruments: 2001 - 2005

I was the individual contributor to the driver layer that connected our software to our measurement hardware through USB and IEEE1394.

  • Maintenance of the legacy USB and IEEE1394 platform abstraction driver.
  • Development of a new API and communication model for future USB and IEEE1394 devices.
  • Primary tools involved were C++, Windows 2000 DDK

University of Oklahoma Health Sciences Center: 2000

  • Sole designer and developer of a web interface for recording and tracking structured lab notes on genetic sequences

Internships: 1997 - 1998

  • Hewlett-Packard — math sciences automated test engineer
  • Halliburton — system administrator
  • Landmark Graphics — software tester

Education

Bachelor of Science in Computer Science with a minor in Mathematics from the University of Oklahoma. Graduated with honors in December, 2000.

Dogwood Challenge, Week 1, Self-Portait

Take a picture that tells us who you are, without actually showing your face.

_DSC2092.jpg

For my self-portrait, I could think of nothing more appropriate than my work desk. Not precisely as I have it day-to-day, but not greatly rearranged, either. The distinction between who I am and what I do is pretty minimal, for better or for worse.

  • trans
  • code on the screen
  • wacom tablet nearby
  • camera parts
  • home-made crochet hand warmers in bi pride colors
  • I Voted!
  • mug of tea in the background

Error Handling in Haskell

The Kinds of Error Reports

  • Exceptions
  • Either
  • ErrorT or EitherT

Parsing a File

  • parseImage :: ByteString -> Either ParseError (Image PixelRGB8)
  • readFile :: FilePath -> IO ByteString
  • readImageFile fname = readFile fname »= return . parseImage :: FilePath -> IO (Either ParseError (Image PixelRGB8))

Exceptions

  • throw :: Exception e => e -> a
  • throwIO :: Exception e => e -> IO a
  • catch :: Exception e => IO a -> (e -> IO a) -> IO a
  • handle :: Exception e => (e -> IO a) -> IO a -> IO a
  • try :: Exception e => IO a -> IO (Either e a)
  • throwTo :: Exception e => ThreadId -> e -> IO ()
  • error :: String -> a

Exceptions

\footnotesize

readFileExc :: FilePath -> IO ByteString
readFileExc = handle silenceENoEnt . readFile
  where
    silenceENoEnt :: IOException -> IO ByteString
    silenceENoEnt exc | isDoesNotExistError exc = return empty
                      | otherwise = throw exc

readImageFileExc :: FilePath -> IO Image
readImageFileExc fn = do
    bs <- readFileExc fn
    either throw return (parseImage bs)

\normalsize

Either

\footnotesize

data ReadImageError = ParseError ParseError | ReadError IOException

readFileEither :: FilePath -> IO (Either IOException ByteString)
readFileEither fn = try (readFile fn) >>= return . either silenceENoEnt Right
  where
    silenceENoEnt :: IOException -> Either IOException ByteString
    silenceENoEnt exc | isDoesNotExistError exc = Right empty
                      | otherwise = Left exc

readImageFileEither :: FilePath -> IO (Either ReadImageError Image)
readImageFileEither fn = do
    mBs <- readFileEither fn
    return $ case mBs of
        Left err -> Left (ReadError err)
        Right bs -> either (Left . ParseError) Right (parseImage bs)

\normalsize

ErrorT and EitherT

  • newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
  • newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }

ErrorT and EitherT

  • newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
  • newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }
  • EitherT :: m (Either e a) -> EitherT e m a
  • runEitherT :: EitherT e m a -> m (Either e a)

EitherT

  • catch :: Exception e => IO a -> (e -> IO a) -> IO a
  • catch :: Exception e => IO (Either e a) -> (e -> IO (Either e’ a)) -> IO (Either e’ a)
  • catchT :: Monad m => EitherT e m a -> (e -> EitherT e’ m a) -> (EitherT e’ m a)

EitherT

  • handle :: Exception e => (e -> IO a) -> IO a -> IO a
  • handleT :: Monad m => (e -> EitherT e’ m a) -> EitherT e m a -> (EitherT e’ m a)

EitherT

  • try :: Exception e => IO a -> IO (Either e a)
  • tryIO :: MonadIO m => IO a -> EitherT IOException m a
  • EitherT . try :: Exception e => IO a -> EitherT e IO a

EitherT

\footnotesize

catchT :: forall e e' m a. Monad m
          => EitherT e m a
          -> (e -> EitherT e' m a)
          -> EitherT e' m a
catchT action handler = EitherT $ do
    res <- runEitherT action :: m (Either e a)
    case res of
        Right val -> return (Right val)
        Left err -> runEitherT (handler err)

\normalsize

MonadError

\footnotesize

class Monad m => MonadError e m | m -> e where
    throwError :: e -> m a
    catchError :: m a -> (e -> m a) -> m a

\normalsize

Revisiting readImageFileEither

\footnotesize

data ReadImageError = ParseError ParseError | ReadError IOException

readImageFileEither :: FilePath -> IO (Either ReadImageError Image)
readImageFileEither fn = do
    mBs <- readFileEither fn
    return $ case mBs of
        Left err -> Left (ReadError err)
        Right bs -> either (Left . ParseError) Right (parseImage bs)

\normalsize

Revisiting readImageFileEither

\footnotesize

data ReadImageError = ParseError ParseError | ReadError IOException

readImageFileEither :: FilePath -> EitherT ReadImageError IO Image
readImageFileEither fn =

\normalsize

Revisiting readImageFileEither

\footnotesize

readImageFileEither' :: FilePath -> EitherT ReadImageError IO Image
readImageFileEither' fn = do
    bs <- readFileEither' fn :: EitherT IOException IO ByteString

\normalsize

Revisiting readImageFileEither

\footnotesize

readImageFileEither' :: FilePath -> EitherT ReadImageError IO Image
readImageFileEither' fn = do
    bs <- handleT (throwError . ReadError) (readFileEither' fn)
                :: EitherT ReadImageError IO ByteString

\normalsize

Revisiting readImageFileEither

\footnotesize

readImageFileEither' :: FilePath -> EitherT ReadImageError IO Image
readImageFileEither' fn = do
    bs <- handleT (throwError . ReadError) (readFileEither' fn)
    case parseImage bs of
        Right val -> return val
        Left exc -> throwError (ParseError exc)

\normalsize

Revisiting readImageFileEither

\footnotesize

readImageFileEither' :: FilePath -> EitherT ReadImageError IO Image
readImageFileEither' fn = do
    bs <- handleT (throwError . ReadError) (readFileEither' fn)
    either (throwError . ParseError) return (parseImage bs)

\normalsize

Revisiting readImageFileEither

\footnotesize

readFileExc :: FilePath -> IO ByteString
readFileExc = handle silenceENoEnt . readFile
  where
    silenceENoEnt :: IOException -> IO ByteString
    silenceENoEnt exc | isDoesNotExistError exc = return empty
                      | otherwise = throw exc

readFileEither' :: FilePath -> EitherT IOException IO ByteString
readFileEither' = handleT silenceENoEnt . tryIO . readFile
  where
    silenceENoEnt :: IOException -> EitherT IOException IO ByteString
    silenceENoEnt exc | isDoesNotExistError exc = return empty
                      | otherwise = throwError exc

\normalsize

Revisiting readImageFileEither

\footnotesize

silenceENoEnt' :: (MonadError IOException m, MonadIO m)
               => IOException
               -> m ByteString
silenceENoEnt' exc
    | isDoesNotExistError exc = return empty
    | otherwise = throwError exc

readFileExc :: FilePath -> IO ByteString
readFileExc = handle silenceENoEnt' . readFile

readFileEither' :: FilePath -> EitherT IOException IO ByteString
readFileEither' = handleT silenceENoEnt' . tryIO . readFile

\normalsize

Building an Application Stack

\footnotesize

data DiskStore = DiskStore { root :: FilePath }

newtype DiskStoreM a =
        DSM {
            uDSM :: ReaderT DiskStore
                            (EitherT DataStoreError IO)
                            a }
    deriving ( Functor, Applicative, Monad, MonadIO,
             , MonadReader DiskStore, MonadError DataStoreError )

\normalsize

Put an Object In

\footnotesize

putObject :: DataObject obj
          => Path
          -> obj
          -> Maybe ObjVersion
          -> DiskStoreM ObjVersion
putObject path obj mVer = do
    DiskStore{..} <- ask
    let fsPath = root </> "objects" </> T.unpack (T.intercalate "/" elems)
    createDirectoryIfMissing True (dropFileName fsPath)
    BS.writeFile fsPath (content obj)
    return (ObjVersion T.empty)

\normalsize

  • createDirectoryIfMissing :: Bool -> FilePath -> IO ()
  • writeFile :: FilePath -> ByteString -> IO ()

hoistIO

(IOException -> EitherT DataStoreError IO a) -> IO a -> DiskStoreM a

hoistIO

\footnotesize

hoistIO :: (IOException -> EitherT DataStoreError IO a)
        -> IO a
        -> EitherT IOException IO a
hoistIO handler action =
    tryIO action

\normalsize

hoistIO

\footnotesize

hoistIO :: (IOException -> EitherT DataStoreError IO a)
        -> IO a
        -> EitherT DataStoreError IO a
hoistIO handler action =
    handleT handler (tryIO action)

\normalsize

hoistIO

\footnotesize

hoistIO :: (IOException -> EitherT DataStoreError IO a)
        -> IO a
        -> ReaderT DiskStore (EitherT DataStoreError IO) a
hoistIO handler action =
    ReaderT (\_ -> handleT handler
                           (tryIO action))

hoistIO handler action =
    lift (handleT (throwError . handler)
                  (tryIO action))

\normalsize

hoistIO

\footnotesize

hoistIO :: (IOException -> EitherT DataStoreError IO a)
        -> IO a
        -> DiskStoreM a
hoistIO handler action =
    DSM (lift (handleT handler (tryIO action)))

\normalsize

Back to adding the object

\footnotesize

putObject :: DataObject obj => Path
                            -> obj
                            -> Maybe ObjVersion
                            -> DiskStoreM ObjVersion
putObject (Path elems) obj mVer = do
    DiskStore{..} <- ask
    let fsPath = root </> "objects" </> T.unpack (T.intercalate "/" elems)
    hoistIO (throwError . trIOExc) $ do
        createDirectoryIfMissing True (dropFileName fsPath)
        BS.writeFile fsPath (content obj)
    return (ObjVersion T.empty)

\normalsize

Catching multiple types of Exceptions

This page left blank

Catching and handling inside the monad

\footnotesize

putObject :: DataObject obj => Path
                            -> obj
                            -> Maybe ObjVersion
                            -> DiskStoreM ObjVersion
putObject (Path elems) obj mVer = do
    DiskStore{..} <- ask
    let fsPath = root </> "objects" </> T.unpack (T.intercalate "/" elems)
    res <- liftIO $ do
        createDirectoryIfMissing True (dropFileName fsPath)
        BS.writeFile fsPath (content obj)
    return (ObjVersion T.empty)

\normalsize

Links