Unnecessarily knot tying solution to nested-map-reduce-traversal challenge.

Main.hs

{- Unnecessarily knot tying solution to https://github.com/josevalim/nested-map-reduce-traversal

   You can run it with:
    $ ghc Main.hs && ./Main

   Which outputs:
    Numbered 0 ("One",[Numbered 0 "A",Numbered 1 "B"])
    Numbered 1 ("Two",[Numbered 2 "C",Numbered 3 "D",Numbered 4 "E"])
    Numbered 2 ("Three",[Numbered 0 "F",Numbered 1 "G"])
    Numbered 3 ("Four",[])
    Numbered 4 ("Five",[Numbered 0 "H"])
-}
module Main where

import Data.List (tails, nub)

type SectionTitle = String

type Lesson = String

data Section = Section
  { title :: SectionTitle
  , reset_lesson_position :: Bool
  , lessons :: [Lesson]
  }
  deriving Show

data Numbered a = Numbered Int a
  deriving (Show)

type Result = (SectionTitle, [Numbered Lesson])

data Counter = Reset | Add
  deriving Eq

main = putStrLn $ unlines $ map show results
  where
  (results, indices) = numberIt sections indices
  sections =
    [ Section "One"   True  ["A", "B"]
    , Section "Two"   False ["C", "D", "E"]
    , Section "Three" True  ["F", "G"]
    , Section "Four"  False []
    , Section "Five"  True  ["H"]
    ]

count :: [Counter] -> [Int]
count = concatMap index . splitEvery Reset
  where
  index :: [a] -> [Int]
  index xs = take (length xs) [0..]

  -- split on every 'x', removing it from the result
  splitEvery x xs =
    case span (/=x) xs of
      (ys, z:zs) -> ys : splitEvery x zs
      (ys, []) -> [ys]

numberIt :: [Section] -> [Int] -> ([Numbered Result], [Int])
numberIt sections indices =
  ( numbered $ group $ zipWith Numbered indices $ flatten sections
  , count $ counters sections
  )
  where
  counters :: [Section] -> [Counter]
  counters = concatMap scounters
    where
    scounters (Section _ reset lessons) =
      let adds = take (length lessons) (repeat Add) in
      if reset
       then Reset : adds
       else adds

  flatten :: [Section] -> [(SectionTitle, Lesson)]
  flatten sections = concatMap flat sections
    where
    flat (Section title _ lessons) = map (title,) lessons

  group :: [Numbered (SectionTitle, Lesson)] -> [Result]
  group xs =  map groupBy $ map title sections
    where
    section (Numbered _ (s,_)) = s
    lesson  (Numbered n (_,l)) = Numbered n l
    groupBy title = (title, map lesson $ filter ((== title) . section) xs)

  numbered :: [a] -> [Numbered a]
  numbered xs = zipWith Numbered [0..] xs