Haskell Quiz/Grid Folding/Solution Kuklewicz

-- Solution by Chris Kuklewicz <haskell@list.mightyreason.com>
-- Posted at http://haskell.org/haskellwiki/Haskell_Quiz/Grid_Folding
-- Original puzzle http://www.rubyquiz.com/quiz63.html
-- Usage : 
--   myFold 2 "RB"
--   myFold 16 "TBLRTBLR"
--
-- This works not by bulding the whole [1..size*size] data structure
-- and manipulating it, but by building a description of which
-- oriented subsets of the paper (of type Bound) are above each other.
--
-- The 'f' function uses the cut operation to split a Bound into two
-- parts which 'f' then re-arranges (using swap), returning them in
-- (above,below) order. The order of the new stack is created and
-- maintained by using f_around and do_op.
--
-- At the end of the operations each Bound should specify a single
-- location, which is checked by decode.

module Main(myFold) where

import Data.List(foldl')
type Bound = ((Int,Int),(Int,Int))

myFold :: Int -> [Char] -> [Int]
myFold size ops = map decode (foldl' do_op wholePaper ops)
  where do_op bs op = foldl' f_around id bs $ []
          where f_around acc b = let (above,below) = f op b
                                 in (above:) . acc . (below:)
        wholePaper = [((0,pred size),(0,pred size))]
        decode ((r1,r2),(c1,c2)) | r1 /= r2 || c1 /= c2 = error "Not enough folds"
                                 | otherwise = 1+size*r1+c1

f :: Char -> Bound -> (Bound,Bound)
f op (rs,cs) = let (r1,r2) = cut rs
                   (c1,c2) = cut cs
               in case op of
                    'T' -> ((swap r1,cs),(r2,cs))
                    'B' -> ((swap r2,cs),(r1,cs))
                    'L' -> ((rs,swap c1),(rs,c2))
                    'R' -> ((rs,swap c2),(rs,c1))
                    _ -> error $ op:" is an unknown character"
  where swap (x,y) = (y,x)
        cut (x,y) | x == y = error $ op:" Cannot fold again"
                  | otherwise = let l = (x + y - 1) `div` 2
                                    h = (x + y + 1) `div` 2
                                in if x < y then ((x,l),(h,y))
                                            else ((x,h),(l,y))