Monad challenges https://mightybyte.github.io/monad-challenges/

Set1.hs

{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE RebindableSyntax  #-}

module Set1 where

import MCPrelude

type Gen a = Seed -> (a, Seed)

fiveRands :: [Integer]
fiveRands = [r1, r2, r3, r4, r5]
  where
    s0 = mkSeed 1
    (r1, s1) = rand s0
    (r2, s2) = rand s1
    (r3, s3) = rand s2
    (r4, s4) = rand s3
    (r5, s5) = rand s4

randLetter :: Gen Char
randLetter s = (toLetter n, s')
  where
    (n, s') = rand s

randString3 :: String
randString3 = [c1, c2, c3]
  where
    s0 = mkSeed 1
    (c1, s1) = randLetter s0
    (c2, s2) = randLetter s1
    (c3, s3) = randLetter s2

generalA f g s = (g n, s')
  where
    (n, s') = f s

randEven :: Gen Integer -- the output of rand * 2
randEven = generalA rand (* 2)

randOdd :: Gen Integer -- the output of rand * 2 + 1
randOdd = generalA randEven (+ 1)

randTen :: Gen Integer -- the output of rand * 10
randTen = generalA rand (* 10)

randPair :: Gen (Char, Integer)
randPair s = ((c, n), s2)
  where
    (c, s1) = generalA randLetter id s
    (n, s2) = generalA rand id s1

generalPair :: Gen a -> Gen b -> Gen (a,b)
generalPair ga gb s = ((a, b), s2)
  where
    (a, s1) = ga s
    (b, s2) = gb s1

generalB f ga gb s = (f a b, s2)
  where
    (a, s1) = ga s
    (b, s2) = gb s1

generalPair2 = generalB (,)

repRandom :: [Gen a] -> Gen [a]
repRandom [] s = ([], s)
repRandom (g : gs) s = (a : as, s2)
  where
    (a, s1) = g s
    (as, s2) = repRandom gs s1

genTwo :: Gen a -> (a -> Gen b) -> Gen b
genTwo gen f s = f v s1
  where
    (v, s1) = gen s

mkGen :: a -> Gen a
mkGen x s = (x, s)

Set2.hs

{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE RebindableSyntax  #-}

module Set2 where

import MCPrelude

data Maybe a = Nothing | Just a

instance Show a => Show (Maybe a) where
  show Nothing = "Nothing"
  show (Just a) = "Just " ++ show a

headMay :: [a] -> Maybe a
headMay [] = Nothing
headMay (x : _) = Just x

tailMay :: [a] -> Maybe [a]
tailMay [] = Nothing
tailMay (_ : xs) = Just xs

lookupMay :: Eq a => a -> [(a, b)] -> Maybe b
lookupMay x [] = Nothing
lookupMay x ((a, b) : _) | x == a = Just b
lookupMay x (_ : as) = lookupMay x as

divMay :: (Eq a, Fractional a) => a -> a -> Maybe a
divMay a 0 = Nothing
divMay a b = Just (a / b)

maximumMay :: Ord a => [a] -> Maybe a
maximumMay [] = Nothing
maximumMay (x : xs) = Just (go x xs)
  where
    go m [] = m
    go m (x : xs) | x > m = go x xs
    go m (x : xs) = go m xs

minimumMay :: Ord a => [a] -> Maybe a
minimumMay [] = Nothing
minimumMay (x : xs) = Just (go x xs)
  where
    go m [] = m
    go m (x : xs) | x < m = go x xs
    go m (x : xs) = go m xs

queryGreek :: GreekData -> String -> Maybe Double
queryGreek gs s =
  case lookupMay s gs of
    Nothing -> Nothing
    Just ns -> case tailMay ns of
      Nothing -> Nothing
      Just t -> case maximumMay t of
        Nothing -> Nothing
        Just m -> case headMay ns of
          Nothing -> Nothing
          Just h -> divMay (fromIntegral m) (fromIntegral h)

link :: Maybe a -> (a -> Maybe b) -> Maybe b
link Nothing _ = Nothing
link (Just x) f = f x

chain :: (a -> Maybe b) -> Maybe a -> Maybe b
chain f Nothing = Nothing
chain f (Just x) = f x

queryGreek2 :: GreekData -> String -> Maybe Double
queryGreek2 gs s =
  link (lookupMay s gs) (\ns ->
  link (tailMay ns) (\t ->
  link (maximumMay t) (\m ->
  link (headMay ns) (\h ->
  divMay (fromIntegral m) (fromIntegral h)))))

mkMaybe :: a -> Maybe a
mkMaybe = Just

addSalaries :: [(String, Integer)] -> String -> String -> Maybe Integer
addSalaries xs p1 p2 =
  link (lookupMay p1 xs) (\s1 ->
  link (lookupMay p2 xs) (\s2 ->
  mkMaybe (s1 + s2)))

yLink f x1 x2 =
  link (x1) (\r1 ->
  link (x2) (\r2 ->
  mkMaybe (f r1 r2)))

addSalaries2 xs p1 p2 = yLink (+) (lookupMay p1 xs) (lookupMay p2 xs)

tailProd :: Num a => [a] -> Maybe a
tailProd xs = link (tailMay xs) (mkMaybe . product)

tailSum :: Num a => [a] -> Maybe a
tailSum xs = link (tailMay xs) (mkMaybe . sum)

transMaybe :: (a -> b) -> Maybe a -> Maybe b
transMaybe g x = link x (mkMaybe . g)

tailSum2 :: Num a => [a] -> Maybe a
tailSum2 = transMaybe sum . tailMay

tailMax :: (Ord a) => [a] -> Maybe (Maybe a)
tailMax = transMaybe maximumMay . tailMay

tailMin :: (Ord a) => [a] -> Maybe (Maybe a)
tailMin = transMaybe minimumMay . tailMay

combine :: Maybe (Maybe a) -> Maybe a
combine Nothing = Nothing
combine (Just x) = x

Set3.hs

module Set3 where

allPairs :: [a] -> [b] -> [(a,b)]
allPairs xs ys = concat $ map f xs
  where
    f x = map (g x) ys
    g x y = (x, y)

data Card = Card Int String
instance Show Card where
  show (Card x h) = show x ++ h

allCards :: [Int] -> [String] -> [Card]
allCards ranks suits = concat $ map f ranks
  where
    f rank = map (Card rank) suits

allCombs :: (a -> b -> c) -> [a] -> [b] -> [c]
allCombs f xs ys = concat $ map g xs
  where
    g x = map (f x) ys

allPairs' = allCombs (,)
allCards' = allCombs Card

allCombs3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
allCombs3 f xs ys zs = allCombs (\x (y, z) -> f x y z) xs (allCombs (,) ys zs)

combStep :: [a -> b] -> [a] -> [b]
combStep fs xs = concat $ map g fs
  where
    g f = map f xs

allCombs' :: (a -> b -> c) -> [a] -> [b] -> [c]
allCombs' f xs ys = [f] `combStep` xs `combStep` ys

allCombs3' :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
allCombs3' f xs ys zs = [f] `combStep` xs `combStep` ys `combStep` zs

Hey, hey, where are the last two sets! I need them :P
By the way, nice coding skills!