Haskell and type composition the easy way

Below is a small Haskell module that I wrote as an exercise. It defines nifty little utility in the form of a generic type composition mechanism. A composite type is any type in which a type constructor is applied to a another type (denoted with type variables, like a (b c)). It can represent for example a list of optional values, i.e [Maybe Int], aka [] (Maybe Int), or an IO operation sequence that operates on a list of values (IO [a]), etc.

Haskell provides many useful high-level programming constructs for managing individual types, but its standard libraries lack a truly flexible denotation for extending those high-level functions to composition data types. Some of these issues are solved by using so-called "monad transformers", which are very sophisticated, but must be separately defined for each individual monad. And as the name says, their application is limited to monads, and they cannot be used for the many quite useful classes of type constructors at the lower levels of the functor hierarchy, such as Functors, Foldables, Traversables or Applicatives.

The small (and silly) test function at the end of the modules shows, how this modules enables flexible intermingling of overlapping data types using both the monadic do syntax and plain fmap calls. While this only seems to apply to compositions of two types at a time, it quite easily generalizes to any number of types, via meta-composition. If a, b, c ... g are functors, then so is (Comp a b). IO [Maybe Int] can be tagged as Comp (Comp IO []) Maybe Int. Hmmm... Maybe the next step is to generalize these operations to a recursive data type representing arbitrary chains of composition.

One cannot help but appreciate how all of these very useful operations are relatively short one-liners. (Readability for persons not familiar with Haskell or Scala is another question.

{-# LANGUAGE FlexibleContexts #-}

-- A generic type composition module by Reino Ruusu, December 2017, Espoo, Finland

-- The simple type composition tag defined here can do many of the tasks that
-- monad transformers are used for, but in a much more generic way, allowing
-- useful compositions of Functors, Foldables, Traversables, Applicatives and
-- Monads (with certain restrictions).

import Control.Applicative
import Control.Monad
import Data.Foldable
import Data.List

-- This type tags a composition type as a parameterized type constructor
newtype Comp m n a = Comp (m (n a))

-- Decorate a `raw' composition type
comp :: m (n a) -> Comp m n a
comp = Comp

-- Undecorate a tagged composition type
decomp :: Comp m n a -> m (n a)
decomp (Comp x) = x

-- Lift a raw outer type to the composition type (inner has to be Applicative)
lift1 :: (Functor m, Applicative n) => m a -> Comp m n a
lift1 = Comp . (pure <$>)

-- Lift a raw inner type to the composition type (outer has to be Applicative)
lift2 :: (Applicative m) => n a -> Comp m n a
lift2 = Comp . pure

-- Foldable instance
instance (Foldable m, Foldable n) => Foldable (Comp m n) where
  -- foldMap :: Monoid k => (a -> k) -> Comp m n a -> k
  foldMap f (Comp x) = foldr (\a l -> foldMap f a `mappend` l) mempty x 

-- Functor instance
instance (Functor m, Functor n) => Functor (Comp m n) where
  -- fmap :: (a -> b) -> (Comp m n a) -> (Comp m n b)
  fmap f (Comp x) = Comp (fmap (fmap f) x)

-- Applicative instance
instance (Applicative m, Applicative n) => Applicative (Comp m n) where
  -- pure :: a -> Comp m n a
  pure = comp . pure . pure
  -- (<*>) :: Comp m n (a -> b) -> Comp m n a -> Comp m n b
  Comp f <*> Comp x = Comp (liftA2 (<*>) f x)

-- Monoid instance
instance (Applicative m, Applicative n, Monoid a) => Monoid (Comp m n a) where
  -- mempty :: Comp m n a
  mempty = pure mempty
  -- mappend :: Comp m n a -> Comp m n a -> Comp m n a
  mappend = (*>)

-- Monad instance (only works if inner type is Traversable, unlike IO, for example)
instance (Monad m, Monad n, Traversable n) => Monad (Comp m n) where
  -- return = pure
  -- (>>=) :: Comp m n a -> (a -> Comp m n b) -> Comp m n b
  Comp x >>= f = Comp $ x >>= fmap join . sequence . fmap (decomp . f)


-- Test routine, builds a (Comp IO []) monad in the do block
-- First fmap (show) applies to (Comp IO [] Int), resulting in (Comp IO [] String).
-- After decomp, second fmap applies to (IO [String]).
-- Execution results in 4*(1 + 4) calls to print, and a return value of
-- "4, 5, 6, 7, 3, 4, 5, 6, 2, 3, 4, 5, 1, 2, 3, 4"

test :: () -> IO String
test () = fmap (intercalate ", ") $ decomp $ fmap (show) $ do
  a <- lift2 [1, 2, 3, 4]
  lift1 (print a)
  b <- lift2 [5, 6, 7, 8]
  lift1 (print (a, b))
  return (b - a) :: Comp IO [] Int

The beauty of Haskell

I've been taking a more serious look into Haskell programming, and have deeply fell in love with its "purity", i.e. its nature as a purely functional programming language, in which everything is expressed entirely in terms of what happens to data.

Another very attracting feature is its very rich toolbox of higher level programming constructs that allow one to express complex data processing tasks in just a few function calls.

A third beautiful aspect of the language is its typing system, which provides automated type matching of undeclared functions and variables. It provides a type checking system just like any other strongly typed language, but without the need to separately declare the types of each and every variable.

On the other hand, these features make Haskell quite difficult to read for people who are not familiar with it, but on the other hand, the amount of code to read can be very small, and absolutely oozing with semantics, i.e. there code is typically very dense, and the reader is not bothered with unnecessary details, such as the name of an iteration variable.

The way in which stateful programming is expressed in Haskell, which is a pure language in the sense that absolutely no side effects are allowed in the code, can be a bit confusing for a beginner, but after one gets the hang of it, one starts to really appreciate the pure functional programming paradigm.

With no side effects and a strong typing system, any program that compiles actually does something, there is no concept of a run-time failure, except in the case of a match against a partially defined pattern, or similar situations.

Additionally, lazy evaluation allows one to express interactive processes simply as ordinary pure functions, which is really convenient, though may be quite confusing.

Below is an example of a hangman program, written in Haskell, using lazy evaluation and the State monad. The program lets the user guess a word one letter at a time. If the user makes 5 wrong guesses, he loses the game.

-- A hangman game using the State monad in Haskell by Reino Ruusu, 2017

import System.Environment
import System.Random
import Control.Monad.State.Lazy
import Data.Char

-- Hangman IO
main = do
  args <- getArgs
  if null args then
    putStrLn "Please provide a file containing words. (One per line.)"
  else do
    -- Select random word
    words <- readFile (head args)
    word <- randomElement (lines words)
    -- Play the game
    interact $ hangmanMain (map toLower word)

-- Hangman game as a pure lazy string processing function
hangmanMain :: String -> String -> String
hangmanMain word = unlines . ("Welcome to Haskell Hangman":) . hangman . ("":) . lines
  where
    hangman input = map snd $ takeUntil fst $ evalState (sequence steps) initialState
      where
        steps = map (hangmanIteration word) input
        initialState = (initialGuess, 0)
          where
            -- Alphabetic characters replaced with underscores
            initialGuess = map (\w -> if isAlpha w then '_' else w) word

-- A single iteration of hangman: State update followed by output
hangmanIteration :: String -> String -> State (String, Int) (Bool, String)
hangmanIteration word input = update >> report
  where
    update = unless (null input) $ do
      -- Check user's guess and update state
      (guess, strikes) <- get
      if elem l word && not (elem l guess) then
        put (newguess guess, strikes) -- Hit
      else
        put (guess, strikes + 1) -- Miss
      where
        l = head input
        newguess = zipWith (\w g -> if w == l then w else g) word
    report = do
      (guess, strikes) <- get
      -- Status message - example: __a_e__ ###
      let status = guess ++ " " ++ (replicate strikes '#')
      -- Check game outcome
      return $ if guess == word then
                 (True, status ++ "\nYou won!") -- Win
               else if strikes >= 5 then
                 (True, status ++ "\nYou lost! (" ++ word ++ ")") -- Loss
               else
                 (False, status) -- Continue

-- Utility functions

-- Take elements up to and including the first for which f returs True
takeUntil f l = first ++ [head last]
  where (first, last) = break f l

-- Select a random element from a list (as an IO operation)
randomElement list = do
  i <- randomRIO (0, length list - 1)
  return (list !! i)

The execution of the game looks like this:

Welcome to Haskell Hangman
____________
a
____________ #
e
____________ ##
i
_i________i_ ##
o
_i__o_____i_ ##
u
_i__ou____i_ ##
s
_is_ou__s_i_ ##
c
_iscou__s_i_ ##
v
viscou__s_i_ ##
t
viscou_ts_i_ ##
y
viscou_ts_i_ ###
n
viscounts_i_ ###
p
viscounts_ip ###
l
viscounts_ip ####
h
viscountship ####
You won!

Note how the game itself is defined as a pure function that simply processes the input string into the output string. Furthermore, all iteration in the code happens via higher level programming constructs that clearly define rules for processing of data, instead of bothering with low-level things such as updating an iteration variable. All the IO is performed by calling this function via the interact function, which simply maps input and output from the console to a pure function from string to string. The business logic can then be defined purely by describing the relationship between the input and the output, without bothering with any aspects of the IO operations.

The steps of the game are here described using the State monad, which allows one to define processing as a combination of stateful operations.

An almost equally elegant solution can be achieved by the very versatile mapAccumL operation, which provides for simultaneous accumulation of state and processing of data. However, in this approach, the hangmanIteration function is much less understandable in isolation, whereas in the version based on the State monad, the state update is directly specified by the definition of the iteration function itself. The state monad allows us to also make use of elegant and semantically rich higher level constructs, such as unless above.

-- A hangman game in Haskell by Reino Ruusu, 2017

import System.Environment
import System.Random
import Data.List
import Data.Char

-- Hangman IO
main = do
  args <- getArgs
  if null args then
    putStrLn "Please provide a file containing words. (One per line.)"
  else do
    -- Select random word
    words <- readFile (head args)
    word <- randomElement (lines words)
    -- Play the game
    interact $ hangmanMain (map toLower word)

-- Hangman game as a pure lazy string processing function
hangmanMain :: String -> String -> String
hangmanMain word = unlines . ("Welcome to Haskell Hangman":) . hangman . ("":) . lines
  where
    hangman input = map snd $ takeUntil fst output
      where
        output = snd $ mapAccumL (hangmanIteration word) initialState input
        initialState = (initialGuess, 0)
          where
            -- Alphabetic characters replaced with underscores
            initialGuess = map (\w -> if isAlpha w then '_' else w) word

-- A single iteration of hangman: State update followed by output
hangmanIteration :: String -> (String, Int) -> String -> ((String, Int), (Bool, String))
hangmanIteration word state input = (newState, report newState)
  where
    -- Check user's guess and update state
    newState = if null input then
                 state
               else if elem l word && not (elem l guess) then
                 (newguess guess, strikes) -- Hit
               else
                 (guess, strikes + 1) -- Miss
      where
        l = head input
        (guess, strikes) = state
        newguess = zipWith (\w g -> if w == l then w else g) word
    report (guess, strikes) = let
      -- Status message - example: __a_e__ ###
      status = guess ++ " " ++ (replicate strikes '#')
      -- Check game outcome
      in if guess == word then
           (True, status ++ "\nYou won!") -- Win
         else if strikes >= 5 then
           (True, status ++ "\nYou lost! (" ++ word ++ ")") -- Loss
         else
           (False, status) -- Continue

-- Utility functions

-- Take elements up to and including the first for which f returs True
takeUntil f l = first ++ [head last]
  where (first, last) = break f l

-- Select a random element from a list (as an IO operation)
randomElement list = do
  i <- randomRIO (0, length list - 1)
  return (list !! i)