Skip to content

Instantly share code, notes, and snippets.

@jwalgran
Created November 21, 2017 21:57
Show Gist options
  • Save jwalgran/792e50da34cca24a1dbac88f0c676e1e to your computer and use it in GitHub Desktop.
Save jwalgran/792e50da34cca24a1dbac88f0c676e1e to your computer and use it in GitHub Desktop.
Haskell Programming Chapter 19 Notes

Chapter 19 - Applying structure

19.1 Applied structure

A big change of pace from previous chapters. A guided safari through a jungle of real projects.

19.2 Monoid

Templating content in Scotty

import Web.Scotty
import Data.Monoid (mconcat)

main = scotty 3000 $ do 
  get "/:word" $ do
    beam <- param "word" 
    html
    (mconcat
      [ "<h1>Scotty, "
      , beam
      , " me up!</h1>"])

It looks like Prelude.concat would do the same thing as mconcat here. Why?

Concatenating connection parameters (scotty again)

runDb :: SqlPersist (ResourceT IO) a 
  -> IO a

runDb query = do 
  let connStr =
    foldr (\(k,v) t ->
          t <> (encodeUtf8 $
          k <> "=" <> v <> " ")) "" params
  runResourceT
    . withPostgresqlConn connStr 
    $ runSqlConn query

Nice example that could be generalized to stringifying any key/value structure.

Concatenating key configurations (xmonad)

import XMonad
import XMonad.Actions.Volume 
import Data.Map.Lazy (fromList) 
import Data.Monoid (mappend)

main = do
  xmonad def { keys =
    \c -> fromList [ 
      ((0, xK_F6),
        lowerVolume 4 >> return ()), 
      ((0, xK_F7),
        raiseVolume 4 >> return ())
    ] `mappend` keys defaultConfig c
}
keys :: !(XConfig Layout
       -> Map (ButtonMask, KeySym) (X ()))

The ! forces strictness. We'll learn more later.

I used to use xmonad before I had any idea what was going on.

This introduces the Monoid of functions. We are mappending our custom keys function with the default keys function.

Prelude> import Data.Monoid
Prelude> let f = const (Sum 1)
Prelude> let g = const (Sum 2)
Prelude> f 9001
Sum {getSum = 1}
Prelude> g 9001
Sum {getSum = 2}
Prelude> (f <> g) 9001
Sum {getSum = 3}

We use Sum here because to remove the ambiguity around mappending Ints.

Prelude> import qualified Data.Map as M
Prelude M> :t M.fromList
M.fromList :: Ord k => [(k, a)] -> Map k a
Prelude M> let f = M.fromList [('a', 1)]
Prelude M> let g = M.fromList [('b', 2)]
Prelude M> :t f
f :: Num a => Map Char a
Prelude M> import Data.Monoid
Prelude M Data.Monoid> f <> g
fromList [('a',1),('b',2)]
Prelude M Data.Monoid> :t (f <> g)
(f <> g) :: Num a => Map Char a
Prelude M Data.Monoid> mappend f g
fromList [('a',1),('b',2)]
Prelude M Data.Monoid> f `mappend` g
fromList [('a',1),('b',2)]

If we don't import Data.Monoid f <> g has different behavior.

Prelude> f <> g
fromList [('a',1)]

19.3 Functor

Lifting over IO

UTCTime

import Data.Time.Clock
offsetCurrentTime :: NominalDiffTime
                  -> IO UTCTime
offsetCurrentTime offset =
  fmap (addUTCTime (offset * 24 * 3600)) $
    getCurrentTime

The clock is in the outside world, so IO.

Specialized fmap looks like this:

We are partially applying addUTCTime and using fmap to work on the IO UTCTimes as if they were UTCTimes.

A nice example of showing how to use library functions with data obtained from the outside world.

UUID

import Data.Text (Text) 
import qualified Data.Text as T
import qualified Data.UUID as UUID 
import qualified Data.UUID.V4 as UUIDv4

textUuid :: IO Text
textUuid =
  fmap (T.pack . UUID.toString)
       UUIDv4.nextRandom

Lifting over web app monads (snap)

userAgent :: AppHandler (Maybe UserAgent) 
userAgent =
  (fmap . fmap) userAgent' getRequest

userAgent' :: Request -> Maybe UserAgent 
userAgent' req =
  getHeader "User-Agent" req

This one was a little more "hand-wavy". I understand that we are fmaping into a context, but I don't quite understand the composed fmaps.

19.4 Applicative

hgrev

hgrev hackage

jsonSwitch :: Parser (a -> a) 
jsonSwitch =
  infoOption $(hgRevStateTH jsonFormat) 
  $ long "json"
  <> short 'J'
  <> help
     "Display JSON version information"

parserInfo :: ParserInfo (a -> a) 
parserInfo =
  info (helper <*> verSwitch <* jsonSwitch) 
       fullDesc

<* is another operator from the Applicative typeclass. It allows you to sequence actions, discarding the result of the second argument.

More parsing

JSON

parseJSON :: Value -> Parser a 
(.:) :: FromJSON a
  => Object 
  -> Text
  -> Parser a

instance FromJSON Payload where 
  parseJSON (Object v) =
    Payload <$> v .: "from" 
            <*> v .: "to"
            <*> v .: "subject"
            <*> v .: "body"
            <*> v .: "offset_seconds"
  parseJSON v = typeMismatch "Payload" v

CSV

parseRecord :: Record -> Parser a

instance FromRecord Release where 
  parseRecord v
    | V.length v == 5 = Release <$> v .! 0 
                                <*> v .! 1 
                                <*> v .! 2 
                                <*> v .! 3 
                                <*> v .! 4
    | otherwise = mzero

Key Value

instance Deserializeable ShowInfoResp where
  parser =
    e2err =<< convertPairs
              . HM.fromList <$> parsePairs
    where
      parsePairs :: Parser [(Text, Text)] 
      parsePairs =
        parsePair `sepBy` endOfLine
      
      parsePair =
        liftA2 (,) parseKey parseValue
      parseKey =
        takeTill (==':') <* kvSep
 
      kvSep = string ": "
   
      parseValue = takeTill isEndOfLine

This one instance is a virtual cornucopia of applications of the previous chapters and we believe it demonstrates how much cleaner and more readable these can make your code

"Readable"

And now for something different

module Web.Shipping.Utils ((<||>)) where

import Control.Applicative (liftA2)

(<||>) :: (a -> Bool) 
       -> (a -> Bool)
       -> a
       -> Bool 
(<||>) = liftA2 (||)

Lifting or over structure

Prelude> let f 9001 = True; f _ = False
Prelude> let g 42 = True; g _ = False
Prelude> :t f
f :: (Eq a, Num a) => a -> Bool
Prelude> f 42
False
Prelude> f 9001
True
Prelude> g 42
True
Prelude> g 9001
False

Manual version

Prelude> (\n -> f n || g n) 0
False
Prelude> (\n -> f n || g n) 9001
True
Prelude> :t (\n -> f n || g n)
(\n -> f n || g n)
  :: (Eq a, Num a) => a -> Bool

Helper version

Prelude> (f <||> g) 0
False
Prelude> (f <||> g) 9001
True

19.5 Monad

Opening a network socket

openSocket :: FilePath -> IO Socket
openSocket p = do
  sock <- socket AF_UNIX 
                 Stream
                 defaultProtocol
  connect sock sockAddr
  return sock 
  where sockAddr =
    SockAddrUnix . encodeString $ p

Binding over failure in initialization

main :: IO ()
main = do
  initAndFp <- runEitherT $ do
    fp <- tryHead NoConfig =<< lift getArgs 
    initCfg <- load' fp
    return (initCfg, fp)
  either bail (uncurry boot) initAndFp
  where
    boot initCfg fp =
      void $ runMVC mempty
             oracleModel (core initCfg fp)
    bail NoConfig =
      errorExit "Please pass a config"
    bail (InvalidConfig e) = 
      errorExit
        ("Invalid config " ++ show e) 
    load' fp =
      hoistEither
      . fmapL InvalidConfig
        =<< lift (load fp)

If you found that very dense and di cult to follow at this point, we’d encourage you to have another look at it a er we’ve covered monad transformers.

Will do

19.6 An end-to-end example: URL shortener

A nice little microservice.

Polymorphic literals

Similar to the way numeric literals are polymorphic over the Num typeclass, OverloadedStrings allows defining Text and ByteString instances with string literals.

shawty imports

replicateM :: Monad m => Int -> m a -> m [a] replicateM n act performs the action n times, gathering the results.

liftIO :: IO a -> m aSource Lift a computation from the IO monad.

Data.ByteString.Char8 Manipulate ByteStrings using Char operations.

decodeUtf8 :: ByteString -> Text Source Decode a ByteString containing UTF-8 encoded text that is known to be valid.

encodeUtf8 :: Text -> ByteString Source Encode text using UTF-8 encoding.

Data.Text.Lazy A time and space-efficient implementation of Unicode text using lists of packed arrays.

Database.Redis Provided by hedis, a client library for Redis.

Network.URI defines functions for handling URIs.

System.Random deals with the common task of pseudo-random number generation

Web.Scotty A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp.

Picking a random letter

Randomness requires the outside world so IO monad. Can be generalized to work on getting a random assortment from any list.

Calling replicateM with a list as the second argument

> replicateM 2 [1, 3]
[[1,1],[1,3],[3,1],[3,3]]
> replicateM 3 [1, 3]
[[1,1,1],[1,1,3],[1,3,1],[1,3,3],[3,1,1],[3,1,3],[3,3,1],[3,3,3]]

Why? Not sure. Probably/maybe because of the behavior of the list monad/applicative/functor/monoid. Let's cheat

replicateM cnt0 f =
    loop cnt0
  where
    loop cnt
        | cnt <= 0  = pure []
        | otherwise = liftA2 (:) f (loop (cnt - 1))
liftA2 (:) [1, 3] (liftA2 (:) [1, 3] (pure []))
liftA2 (:) [1, 3] [[1],[3]]
[[1,1],[1,3],[3,1],[3,3]]

Comparing it to Prelude.replicate

> Prelude.replicate 2 [1, 3]
[[1,3],[1,3]]

Redis

For the Mac people, brew install redis works Launch with redis-server

Question on getURI: Why do we have a Maybe inside the Either? Just the way the hedis API works?

Probably to differentiate between connection errors, which would be a Left, and non-existent key, which would be Nothing.

Interesting that linkShorty uses the same method of string concat that is recommended in Javascript (using a list).

Scotty

Cool use of IsString by RoutePattern. A cleaner way of handling the situation than mkRoutePattern :: String -> RoutePattern

Run it

stack exec shawty

Notable that this gracefully handles offline Redis.

Check for collisions

Redis has a nice conditional set that we can take advantage of rather than worry wrapping separate get and set calls in a transaction.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment