A big change of pace from previous chapters. A guided safari through a jungle of real projects.
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?
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.
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 mappend
ing 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 mappend
ing Int
s.
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)]
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 UTCTime
s as if they were UTCTime
s.
A nice example of showing how to use library functions with data obtained from the outside world.
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 fmap
ing into
a context, but I don't quite understand the composed fmap
s.
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.
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"
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
openSocket :: FilePath -> IO Socket
openSocket p = do
sock <- socket AF_UNIX
Stream
defaultProtocol
connect sock sockAddr
return sock
where sockAddr =
SockAddrUnix . encodeString $ p
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
A nice little microservice.
Similar to the way numeric literals are polymorphic over the Num typeclass,
OverloadedStrings
allows defining Text
and ByteString
instances with string
literals.
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.
Randomness requires the outside world so IO monad. Can be generalized to work on getting a random assortment from any list.
> 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]]
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).
Cool use of IsString
by RoutePattern
. A cleaner way of handling the
situation than
mkRoutePattern :: String -> RoutePattern
stack exec shawty
Notable that this gracefully handles offline Redis.
Redis has a nice conditional set that we can take advantage of rather than worry wrapping separate get and set calls in a transaction.