Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Dancing in Haskell: Beauty, Correctness, and Good Technique

Dancing in Haskell: Beauty, Correctness, and Good Technique

Beauty, Correctness, and Good Technique

Philosophy: The Law of Correctness

The Law of Correctness states:

Beautiful code is almost certainly correct, but correct code might not be beautiful.

Philosophy: The Law of God’s One-Liner

For any piece of code, there exists a refactor which approaches a one-liner.

Corollary:

If you cannot find the refactor, there is a mistake in your design. Solving the mistake will unlock the refactor.

Following this Law must be balanced with The Principle of Maximum Clarity.

Philosophy: The Principle of Perfect Input

Opposite of The Principle of Maximum Caller Flexibility.

Instead of writing this…

data PriceHistory = ...

shouldIBuyBitcoin :: Maybe PriceHistory -> IO Bool

Write this!

shouldIBuyBitcoin :: PriceHistory -> IO Bool

The same is true of Either or other types with holes in their domains.

Quality-of-Life Library: base-prelude

Written by Nikita Volkov. Only depends on base.

{-# LANGUAGE NoImplicitPrelude #-}

import BasePrelude

Quality-of-Life Library: errors

comeOnSimonWhereIsThis :: Either a b -> Maybe b

With errors by Gabriel Gonzales:

hush  :: Either a b -> Maybe b
hushT :: Monad m => ExceptT a m b -> MaybeT m b

note  :: a -> Maybe b -> Either a b
noteT :: Monad m => a -> MaybeT m b -> ExceptT a m b

hoistMaybe  :: Monad m => Maybe b -> MaybeT m b
hoistEither :: Monad m => Either e a -> ExceptT e m a

failWith :: Applicative m => e -> Maybe a -> ExceptT e m a

Quality-of-Life Library: optparse-generic

Written by Gabriel Gonzales.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

data ChainwebEnv w = ChainwebEnv
  { nodes  :: w ::: Word8    <?> "The number of nodes to simulate"
  , config :: w ::: FilePath <?> "Path to config file"
  , peer   :: w ::: [Text]   <?> "Known peers to connect to"
  } deriving (Generic)

instance ParseRecord (ChainwebEnv Wrapped)

main :: IO ()
main = do
  ChainwebEnv n c p <- unwrapRecord "chainweb"
  ...

Quality-of-Life Library: witherable and compactable

Recall these from base:

mapMaybe :: (a -> Maybe b) -> [a] -> [b]
catMaybes :: [Maybe a] -> [a]
partitionEithers :: [Either a b] -> ([a], [b])

From witherable by Kinoshita Fumiaki:

wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b)

From compactable by Isaac Shapira:

fmapEither :: Functor t => (a -> Either l r) -> t a -> (t l, t r)
traverseEither :: (Applicative f, Traversable t) => (a -> f (Either l r)) -> t a -> f (t l, t r)

Quality-of-Life Library: scheduler

Recall this from async:

-- This starts a thread for every item in `t`!
mapConcurrently :: Traversable t => (a -> IO b) -> t a -> IO (t b)

From scheduler by Alexey Kuleschevich:

-- Also exposed are patterns `Par` and `Par'` which automatically use all
-- available cores.
data Comp = Seq | ParOn [Int] | ParN Word16

-- The `m` is essentially `IO`. Like `mapConcurrently`, item order is preserved.
traverseConcurrently :: (MonadUnliftIO m, Traversable t) => Comp -> (a -> m b) -> t a -> m (t b)

Quality-of-Life Library: nonempty-containers

Adhering to the Principle of Perfect Input

Do you expect your [a] input to be non-empty? Then be honest:

import qualified Data.List.NonEmpty as NEL

-- Or use `NEL.head`, which is total!
foo :: NEL.NonEmpty a -> ...
foo (a :| rest) = ...

nonempty-containers by Justin Le provides NESet, NEMap, and NESeq. All have an instance of Foldable1:

class Foldable t => Foldable1 t where
  fold1 :: Semigroup m => t m -> m
  foldMap1 :: Semigroup m => (a -> m) -> t a -> m
  toNonEmpty :: t a -> NonEmpty a

Quality-of-Life Library: generic-lens

Recall a common pattern for generating lenses:

{-# LANGUAGE TemplateHaskell #-}

data Cat = Cat { _name :: Text, _age :: Word, _money :: Double }
makeLenses ''Cat

>>> let jack = Cat "Jack" 6 10.0

>>> jack ^. name
"Jack"

>>> jack & money += 5.0
Cat "Jack" 6 15.0

Quality-of-Life Library: generic-lens (continued)

With generic-lens written by Csongor Kiss:

{-# LANGUAGE DeriveGeneric  #-}

data Cat = Cat { name :: Text, age :: Word, money :: Double } deriving (Generic)

>>> let jack = Cat "Jack" 6 10.0

>>> jack ^. field @"name"
"Jack"

>>> jack & field @"money" += 5.0
Cat "Jack" 6 15.0

But we also get sane ToJSON and FromJSON instances this way!

Quality-of-Life Library: strict-tuple

oracle :: Stream (Of Question) IO r -> Stream (Of (Hint, Warning)) IO r

This causes a space leak.

With strict-tuple by Mitchell Rosen:

import Data.Tuple.Strict (T2(..))

oracle :: Stream (Of Question) IO r -> Stream (Of (T2 Hint Warning)) IO r

Pattern: Strict Data

data JohnsWorkout = JohnsWorkout
  { duration   :: Word
  , location   :: Location
  , activities :: [Activity] }

{-# LANGUAGE BangPatterns #-}

data JohnsWorkout = JohnsWorkout
  { duration   :: {-# UNPACK #-} !Word
  , location   :: !Location
  , activities :: ![Activity] }

This reduces strain on the strictness checker inside GHC.

Lens: MonadState, (%=), and (.=)

data Env = Env { _foo :: Foo, ... }
makeLenses ''Env

bar :: Foo -> Foo

work :: MonadState Env m => ...
work ... = do
  env <- get
  put $ env { _foo = bar $ _foo env }

work :: MonadState Env m => ...
work ... = modify' (\env -> env { _foo = bar $ _foo env })

work :: MonadState Env m => ...
work ... = foo %= bar

Language Extension: Avoid RecordWildCards

{-# LANGUAGE RecordWildCards #-}

data LaunchTarget = LaunchTarget { _planet :: Planet, _time :: Time, _orbit :: Orbit }

elon :: LaunchTarget -> IO ()
elon LaunchTarget{..} = do
  f _planet
  g _orbit
  ...

This does code-gen and slows compiles!

Language Extension: Use LambdaCase

work :: Foo -> IO (Maybe Bar)

solveFamousMathProblem :: Foo -> IO ()
solveFamousMathProblem foo = work foo >>= \mbar ->
  case mbar of
    Nothing  -> ...
    Just bar -> ...

{-# LANGUAGE LambdaCase #-}

solveFamousMathProblem :: Foo -> IO ()
solveFamousMathProblem foo = work foo >>= \case
  Nothing  -> ...
  Just bar -> ...

solveFamousMathProblem :: Foo -> IO ()
solveFamousMathProblem = work >=> traverse_ f

Misc: Bundling Binaries

Save on binary size and link time, and also plays better with incremental compilation.

Misc: Aggressive newtyping

This is another way to adhere to the Principle of Perfect Input.

sendAMuffin :: Text -> Text -> IO ()
sendAMuffin name address = ...

newtype Name = Name { name :: Text }
newtype Address = Address { address :: Text }

sendAMuffin :: Name -> Address -> IO ()
sendAMuffin name address = ...

Misc: Explicit Exports

This keeps your Haddocks clean and improves compiler performance.

module Noodles
  ( -- * Soups
    -- | Noodles in some sort of broth.
    -- Can be eaten in \(O(\log{n})\) time.

    -- ** Chinese
    beefNoodle, ramen
    -- ** Vietnamese
  , pho
    -- ** Japanese
  , udon, soba
  ) where

Even in your main module:

module Main ( main ) where

Misc: Pockets of MaybeT and ExceptT

getFriend :: IO (Maybe Friend)
sellData  :: Friend -> IO (Maybe Cash)

facebookKiller :: IO ()
facebookKiller = do
  mfriend <- getFriend
  case mfriend of
    Nothing -> putStrLn "No!"
    Just a  -> do
      mdata <- sellData a
      case mdata of
        Nothing -> putStrLn "Zuckerberg wins again..."
        Just b  -> f b

Misc: Pockets of MaybeT and ExceptT (continued)

facebookKiller :: IO ()
facebookKiller = getFriend >>= \case
  Nothing -> putStrLn "No!"
  Just a  -> sellData a >>= \case
    Nothing -> putStrLn "Zuckerberg wins again..."
    Just b  -> f b

import Control.Monad.Trans.Maybe (MaybeT(..))

facebookKiller :: IO ()
facebookKiller = runMaybeT g >>= \case
  Nothing -> putStrLn "Zuckerberg wins again..."
  Just b  -> f b
  where
    g :: MaybeT IO Cash
    g = do
      friend <- MaybeT getFriend
      MaybeT $ sellData friend

But those aren’t the same…

Misc: Pockets of MaybeT and ExceptT (continued)

import Control.Monad.Trans.Except (ExceptT(..))

facebookKiller :: IO ()
facebookKiller = runExceptT g >>= \case
  Left e  -> putStrLn e
  Right b -> f b
  where
    g :: ExceptT Text IO Cash
    g = do
      friend <- noteT "Couldn't find a friend..." $ MaybeT getFriend
      noteT "Caught by the government" . MaybeT $ sellData friend

facebookKiller :: IO ()
facebookKiller = runExceptT g >>= either putStrLn f
  where
    ...

Thank You

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.