Essence of the iterator pattern word count

Main.hs

module Main where

import Data.Bool (bool)
import Control.Monad ((<=<))
import Control.Monad.State (State, evalState, get, put)
import Data.Char (isSpace)
import Data.Foldable (traverse_)
import Data.Functor.Compose (Compose(Compose, getCompose))
import Data.Functor.Const (Const(Const, getConst))
import Data.Functor.Product (Product(Pair))
import Data.Maybe (listToMaybe)
import Data.Monoid (Sum(Sum, getSum))
import Prelude hiding (lines, words)
import System.Environment (getArgs)

prod :: (a -> f b) -> (a -> g b) -> a -> Product f g b
prod f g a = Pair (f a) (g a)

runProd :: (f a -> g a -> b) -> Product f g a -> b
runProd f (Pair fa ga) = f fa ga

type Count = Const (Sum Integer)

getCount :: Count a -> Integer
getCount = getSum . getConst

count :: Count a
count = Const (Sum 1)

ignore :: Count a
ignore = Const (Sum 0)

countWhen :: Bool -> Count a
countWhen = bool ignore count

chars :: Char -> Count ()
chars = const count

lines :: Char -> Count ()
lines = countWhen . ('\n' ==)

type StatefulCount s = Compose (State s) Count

runStatefulCount :: StatefulCount s a -> s -> Integer
runStatefulCount c s = getCount (evalState (getCompose c) s)

words :: Char -> StatefulCount Bool ()
words c =
  Compose $
    curry (countWhen . uncurry ((&&) . not))
      <$> get
      <*  put (not (isSpace c))
      <*> get

data WordCount = WordCount
  { wcChars :: Integer
  , wcLines :: Integer
  , wcWords :: Integer
  } deriving (Show)

wordCount :: String -> WordCount
wordCount =
  runProd (runProd runAll) . traverse (chars `prod` lines `prod` words)
  where
    runAll c l w =
      WordCount (getCount c) (getCount l) (runStatefulCount w False)

-- Result:
-- $ runhaskell Main.hs ./Main.hs
-- WordCount {wcChars = 1857, wcLines = 73, wcWords = 306}

main :: IO ()
main = traverse_ (print . wordCount <=< readFile) =<< listToMaybe <$> getArgs