diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,18 @@
+Copyright 2008 by Audrey Tang
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to
+deal in the Software without restriction, including without limitation the
+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+  
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+   
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/PageIO.cabal b/PageIO.cabal
new file mode 100644
--- /dev/null
+++ b/PageIO.cabal
@@ -0,0 +1,23 @@
+name:               PageIO
+version:            0.0.1
+copyright:          2008 Audrey Tang
+license:            BSD3
+license-file:       LICENSE
+author:             Audrey Tang <audreyt@audreyt.org>
+maintainer:         Audrey Tang <audreyt@audreyt.org>
+synopsis:           Page-oriented extraction and composition library
+description:        Provides an interface to the PageIn export format (.dux)
+                    from the StreamServe Persuasion(tm) platform, using it
+                    both as a data extraction as well as a page layout DSL.
+                    (Extremely experimental, no documentations at the moment!)
+stability:          experimental
+build-type:         Simple
+extensions:         GeneralizedNewtypeDeriving, RecordPuns, ParallelListComp, PatternGuards
+exposed-modules:    Text.PageIO
+                    Text.PageIO.Extract Text.PageIO.LabelMap
+                    Text.PageIO.Parser Text.PageIO.Run
+                    Text.PageIO.Transform Text.PageIO.Types 
+build-depends:      base, array, bytestring, parsec >= 3.0, containers, stringtable-atom, iconv
+extra-source-files: README
+hs-source-dirs:     src
+category:           Text
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,7 @@
+This library provides an interface to the PageIn export format (.dux) from
+the StreamServe Persuasion(tm) platform, using it both as a data extraction
+as well as a page layout DSL.
+
+At the moment it's extremely experimental, with no documentations and
+no examples, and as a whole may not make any sense except for existing
+users of StreamServe. :-)
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/src/Text/PageIO.hs b/src/Text/PageIO.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO.hs
@@ -0,0 +1,10 @@
+module Text.PageIO
+    ( module Text.PageIO.Run
+    , module Text.PageIO.Parser
+    , module Text.PageIO.Transform
+    , module Text.PageIO.Extract
+    ) where
+import Text.PageIO.Run
+import Text.PageIO.Parser
+import Text.PageIO.Transform
+import Text.PageIO.Extract
diff --git a/src/Text/PageIO/Extract.hs b/src/Text/PageIO/Extract.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO/Extract.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, RecordPuns #-}
+{-# OPTIONS -fno-warn-name-shadowing #-}
+
+module Text.PageIO.Extract where
+import Data.Maybe
+import Data.Monoid
+import Text.PageIO.Types
+import qualified Text.PageIO.LabelMap as LM
+import qualified Data.ByteString.Char8 as S
+
+type Area = Page
+newtype BlockResult = MkBlockResult { blockResults :: [(Area, LabelMap Value)] }
+    deriving (Eq, Ord, Monoid)
+
+data SheetResult = MkSheetResult
+    { resultFields  :: LabelMap Value
+    , resultBlocks  :: LabelMap BlockResult
+    }
+    deriving (Eq, Ord)
+
+instance Show BlockResult where
+    show (MkBlockResult []) = "[]"
+    show (MkBlockResult rs) = concatMap prettyBlockResult rs
+        where
+        prettyBlockResult (_, lm) = case LM.toList lm of
+            []      -> "\n  - {}"
+            (v:vs)  -> "\n  - " ++ prettyEntry v ++ concatMap (("    " ++) . prettyEntry) vs
+
+instance Show SheetResult where
+    show (MkSheetResult fs bs) = concat
+        [ "---\n"
+        , concatMap prettyEntry (LM.toList fs)
+        , concatMap prettyEntry (LM.toList bs)
+        ]
+
+prettyEntry :: Show a => (Label, a) -> String
+prettyEntry (lbl, val) = do
+    show lbl ++ ": " ++ show val ++ "\n"
+
+
+extractPage :: Sheet -> Page -> Maybe SheetResult
+extractPage MkSheet{sheetBox, sheetFields, sheetPatterns, sheetFrames} page
+    | and patternResults = Just $ MkSheetResult
+        { resultFields = fieldResults
+        , resultBlocks = frameResults
+        }
+    | otherwise          = Nothing
+    where
+    sheetArea = crop sheetBox page
+    patternResults = map (checkPattern sheetArea) (LM.elems sheetPatterns)
+    fieldResults   = fmap (extractField sheetArea) sheetFields
+    frameResults   = LM.unionsWith mappend (map extractFrame sheetFrames)
+    extractFrame MkFrame{ frameBox, frameBlocks } = LM.fromListWith mappend blockResults
+        where
+        frameArea    = crop frameBox sheetArea
+        blockResults = extractBlocks frameBlocks frameArea
+
+crop :: Box -> Page -> Page
+crop MkBox{boxTop, boxBottom, boxLeft, boxRight} (MkPage lns) = MkPage (map doCol (doRows lns))
+    where
+    doRows = take (boxBottom - boxTop + 1) . drop (boxTop - 1)
+    doCol = S.take (boxRight - boxLeft + 1) . S.drop (boxLeft - 1)
+
+checkPattern :: Page -> Pattern -> Bool
+checkPattern page MkPattern{ patternBox, patternMatch }
+    | val `matches` patternMatch = True
+    | otherwise                  = False
+    where
+    val = pageVal $ crop patternBox page
+
+extractField :: Page -> Field -> Value
+extractField page MkField{ fieldBox } = pageVal $ crop fieldBox page
+
+extractBlocks :: LabelMap Block -> Page -> [(Label, BlockResult)]
+extractBlocks blocks page@(MkPage lns) = case blockResults of
+    []              -> case lns of
+        (_:rest)    -> extractBlocks blocks (MkPage rest)
+        _           -> mempty
+    ((skip, res):_) -> res:extractBlocks blocks (MkPage $ drop skip lns)
+    where
+    blockResults =
+        [ (blockLines b, (lbl, fromJust es))
+        | (lbl, b) <- LM.toList blocks
+        , let es = extractBlock b page, isJust es
+        ]
+
+extractBlock :: Block -> Page -> Maybe BlockResult
+extractBlock MkBlock{ blockLines, blockPatterns, blockFields, blockFilterBy } page@(MkPage lns)
+    | length blockArea < blockLines   = Nothing
+    | and patternResults              = Just . MkBlockResult $ if filtersPass
+        then [(MkPage blockArea, fieldResults)]
+        else []
+    | otherwise                       = Nothing
+    where
+    blockArea       = take blockLines lns
+    patternResults  = map (checkPattern page) (LM.elems blockPatterns)
+    fieldResults    = fmap (extractField page) blockFields
+    filtersPass     = all runFilter blockFilterBy
+    runFilter (flt@MkFilter{ filterField, filterOperator, filterMatch })
+        = case LM.lookup filterField fieldResults of
+            Just val    -> case filterOperator of
+                ONot op     -> not $ runFilter flt{ filterOperator = op }
+                OContains   -> val `matches` filterMatch
+                OStartsWith -> matchValue filterMatch `S.isPrefixOf` val 
+                OEndsWith   -> matchValue filterMatch `S.isSuffixOf` val 
+                OEq         -> matchValue filterMatch == val
+            _           -> False
+
+pageVal :: Page -> Value
+pageVal (MkPage page) = S.concat page
+
diff --git a/src/Text/PageIO/LabelMap.hs b/src/Text/PageIO/LabelMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO/LabelMap.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Text.PageIO.LabelMap where
+
+import StringTable.Atom
+import qualified Data.IntMap as IM
+import Data.Monoid
+
+newtype LabelMap a = MkLabelMap { labelMap :: IM.IntMap a }
+    deriving (Eq, Ord, Functor, Monoid)
+
+newtype Label = MkLabel { labelAtom :: Atom }
+    deriving (Eq, Ord)
+
+instance Show a => Show (LabelMap a) where
+    show = show . toList
+
+instance Show Label where
+    show = fromLabel
+
+toLabel :: ToAtom a => a -> Label
+toLabel = MkLabel . toAtom
+
+fromLabel :: FromAtom a => Label -> a
+fromLabel = fromAtom . labelAtom
+
+fromList :: [(Label, a)] -> LabelMap a
+fromList ps = MkLabelMap $ IM.fromList [ (fromLabel l, x) | (l, x) <- ps ]
+
+fromListWith :: (a -> a -> a) -> [(Label, a)] -> LabelMap a
+fromListWith f ps = MkLabelMap $ IM.fromListWith f [ (fromLabel l, x) | (l, x) <- ps ]
+
+toList :: LabelMap a -> [(Label, a)]
+toList lm = [ (keyToLabel l, x) | (l, x) <- IM.toList $ labelMap lm ]
+
+{-# INLINE keyToLabel #-}
+keyToLabel :: IM.Key -> Label
+keyToLabel = MkLabel . unsafeIntToAtom
+
+mapWithKey :: (Label -> a -> b) -> LabelMap a -> LabelMap b
+mapWithKey f lm = MkLabelMap $ IM.mapWithKey (f . keyToLabel) (labelMap lm)
+
+elems :: LabelMap a -> [a]
+elems = IM.elems . labelMap
+
+unions :: [LabelMap a] -> LabelMap a
+unions = MkLabelMap . IM.unions . Prelude.map labelMap
+
+unionsWith :: (a -> a -> a) -> [LabelMap a] -> LabelMap a
+unionsWith f = MkLabelMap . IM.unionsWith f . Prelude.map labelMap
+
+lookup :: Label -> LabelMap a -> Maybe a
+lookup l = IM.lookup (fromLabel l) . labelMap
+
+insert :: Label -> a -> LabelMap a -> LabelMap a
+insert l v = MkLabelMap . IM.insert (fromLabel l) v . labelMap
+
+insertWith :: (a -> a -> a) -> Label -> a -> LabelMap a -> LabelMap a
+insertWith f l v = MkLabelMap . IM.insertWith f (fromLabel l) v . labelMap
+
+member :: Label -> LabelMap a -> Bool
+member l = IM.member (fromLabel l) . labelMap
+
+keys :: LabelMap a -> [Label]
+keys = Prelude.map keyToLabel . IM.keys . labelMap
+
+filter :: (a -> Bool) -> LabelMap a -> LabelMap a
+filter f = MkLabelMap . IM.filter f . labelMap
+
+mapMaybe :: (a -> Maybe b) -> LabelMap a -> LabelMap b
+mapMaybe f = MkLabelMap . IM.mapMaybe f . labelMap
+
+mapMaybeWithKey :: (Label -> a -> Maybe b) -> LabelMap a -> LabelMap b
+mapMaybeWithKey f = MkLabelMap . IM.mapMaybeWithKey (f . keyToLabel) . labelMap
+
diff --git a/src/Text/PageIO/Parser.hs b/src/Text/PageIO/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO/Parser.hs
@@ -0,0 +1,266 @@
+module Text.PageIO.Parser where
+
+import Text.Parsec
+import Text.Parsec.ByteString
+import Data.ByteString.Lazy.Char8 (pack, ByteString, toChunks)
+import Text.PageIO.Types
+import Control.Monad (liftM3, liftM4)
+import Numeric (readDec)
+import Codec.Text.IConv
+import qualified Data.ByteString.Char8 as S
+import qualified Text.PageIO.LabelMap as LM
+
+readSheet :: String -> IO (Either ParseError Sheet)
+readSheet = parseFromFile sheet
+
+parseMaybe :: Parser a -> Parser (Maybe a)
+parseMaybe r = fmap Just r <|> return Nothing
+
+maybeFieldVariable :: Parser (Maybe Variable)
+maybeFieldVariable = parseMaybe $ do
+    char '$'
+    choice
+        [ sym "PAGE" >> return VPage
+        , literalVariable
+        , functionVariable
+        ]
+
+literalVariable :: Parser Variable
+literalVariable = do
+    s <- literalStr
+    ret $ VLiteral s
+
+functionVariable :: Parser Variable
+functionVariable = do
+    fun <- choice
+        [ sym "SUM("    >> return VSum
+        , sym "COUNT("  >> return VCount
+        ]
+    scope <- choice
+        [ sym "page."   >> return SPage
+        , sym "doc."    >> return SDoc
+        , return SPage
+        ]
+    fld <- many1 $ noneOf ".) "
+    sym ")"
+    return $ fun scope (toLabel fld)
+
+maybeFieldFormat :: Parser (Maybe FieldFormat)
+maybeFieldFormat = parseMaybe $ do 
+    sym "Format"
+    choice
+        [ sym "\"NZ ZZZ ZZ9,99\""       >> return (FNumeric 0)
+        , sym "\"Nk= d=.\""             >> return (FNumeric 0)
+        , sym "\"NZ,ZZZ,ZZZ,ZZ#.##\""   >> return (FNumeric 2)
+        ]
+
+maybeFilters :: Parser (Maybe [Filter])
+maybeFilters = parseMaybe $ do
+    sym "WHERE"
+    parseFilter `sepEndBy` sym "AND"
+
+parseFilter :: Parser Filter
+parseFilter = liftM3 MkFilter parseLabel operator (fmap mkMatch quotedValue)
+
+operator :: Parser Operator
+operator = choice
+    [ sym "NOT"         >> fmap ONot operator
+    , sym "CONTAINS"    >> return OContains
+    , sym "STARTSWITH"  >> return OStartsWith
+    , sym "ENDSWITH"    >> return OEndsWith
+    , sym "=="          >> return OEq
+    , sym "="           >> return OEq
+    , sym "!="          >> return (ONot OEq)
+    , sym "<>"          >> return (ONot OEq)
+    ]
+
+maybeOrderBys :: Parser (Maybe [OrderBy Label])
+maybeOrderBys = parseMaybe $ do
+    sym "ORDER"
+    sym "BY"
+    orders <- (`sepEndBy` sym ",") $ do
+        lbl <- parseLabel
+        choice
+            [ sym "DESC"            >> return (DDescending lbl)
+            , optional (sym "ASC")  >> return (DAscending lbl)
+            ]
+    ret $ orders
+
+maybeBy :: String -> Parser (Maybe [Label])
+maybeBy by = parseMaybe $ do
+    sym by
+    sym "BY"
+    lbls <- parseLabel `sepEndBy` sym ","
+    ret $ lbls
+
+maybeRule :: Parser (Maybe a) -> Parser (Maybe a)
+maybeRule p = (<|> return Nothing) $ do
+    between (sym "Rule" >> sym "\"") (sym "\";") p
+
+parseLabel :: Parser Label
+parseLabel = do
+    s   <- many (noneOf "\", ") 
+    ret $ toLabel s
+
+sheet :: Parser Sheet
+sheet = do
+    manyTill anyChar (sym "UseCharPos" <|> sym "UseGridPos")
+    sym "Sheet"
+    right   <- num
+    bottom  <- num
+    optional (sym "UsePriority")
+    pats    <- many pattern
+    grp     <- maybeRule $ maybeBy "GROUP"
+    flds    <- many field
+    frames  <- many frame
+    sym "End"
+    ret $ MkSheet
+        { sheetBox      = MkBox
+            { boxLeft   = 1
+            , boxTop    = 1
+            , boxRight  = right
+            , boxBottom = bottom
+            }
+        , sheetPatterns = LM.fromList
+            [ (lbl, pat{ patternBox = box{ boxRight = right } })
+            | (lbl, pat) <- pats, let box = patternBox pat
+            ]
+        , sheetFields   = LM.fromList flds
+        , sheetFrames   = (`fmap` frames) $ \frm -> frm
+            { frameBlocks = (`fmap` frameBlocks frm) $ \blk -> blk
+                { blockPatterns = (`fmap` blockPatterns blk) $ \pat -> pat
+                    { patternBox = (patternBox pat){ boxRight = right }
+                    }
+                }
+            }
+        , sheetGroupBy  = maybe [] id grp
+        }
+
+sym :: String -> Parser ()
+sym s = try (string s) >> sp
+
+ret :: a -> Parser a
+ret x = sp >> return x
+
+sp :: Parser ()
+sp = skipMany (space <|> (try (string "//") >> skipMany (noneOf ['\n']) >> anyChar))
+
+num :: Parser Int
+num = do
+    digits <- many1 digit
+    ret $ fst (head $ readDec digits)
+
+pattern :: Parser (Label, Pattern)
+pattern = do
+    sym "Match"
+    lbl     <- labelStr
+    left    <- num
+    top     <- num
+    mat     <- matchStr
+    wc      <- (sym "UseWildCards" >> return True) <|> return False
+    retLabel lbl MkPattern
+        { patternBox    = MkBox
+            { boxLeft   = left
+            , boxTop    = top
+            , boxRight  = error "To be updated later"
+            , boxBottom = top
+            }
+        , patternMatch        = mat
+        , patternUseWildcards = wc
+        }
+
+field :: Parser (Label, Field)
+field = do
+    sym "Field"
+    lbl <- labelStr
+    box <- boxNumbers
+    var <- maybeFieldVariable
+    fmt <- maybeFieldFormat
+    char ';'
+    retLabel lbl MkField
+        { fieldBox         = box
+        , fieldKeepSpaces  = True
+        , fieldVariable    = var
+        , fieldFormat      = maybe FGeneral id fmt
+        }
+
+boxNumbers :: Parser Box
+boxNumbers = liftM4 MkBox num num num num
+
+frame :: Parser Frame
+frame = do
+    sym "Frame"
+    box     <- boxNumbers
+    blocks  <- many block
+    sym "End"
+    ret $ MkFrame
+        { frameBox    = box
+        , frameBlocks = LM.fromList blocks
+        }
+
+retLabel :: Label -> a -> Parser (Label, a)
+retLabel l x = ret (l, x)
+
+block :: Parser (Label, Block)
+block = do
+    sym "Block"
+    lbl     <- labelStr
+    optional (sym "UsePriority")
+    sym "Lines"
+    lns     <- num
+    pats    <- many pattern
+    (filters, orders) <- fmap (maybe (Nothing, Nothing) id) . maybeRule $ do
+        filters <- maybeFilters
+        orders  <- maybeOrderBys
+        return (Just (filters, orders))
+    flds    <- many field
+    sym "End"
+    retLabel lbl MkBlock
+        { blockLines    = lns
+        , blockPatterns = LM.fromList
+            [ (l, pat{ patternBox = adjustBox box })
+            | (l, pat) <- pats, let box = patternBox pat
+            ]
+        , blockFields   = LM.fromList
+            [ (l, fld{ fieldBox = adjustBox box })
+            | (l, fld) <- flds, let box = fieldBox fld
+            ]
+        , blockOrderBy  = maybe [] id orders
+        , blockFilterBy = maybe [] id filters
+        }
+    where
+    -- We adjust box because StreamServe counts in-block coordinates from (0,0).
+    adjustBox (MkBox l t r b) = MkBox (l+1) (t+1) (r+1) (b+1)
+
+literalStr :: Parser Value 
+literalStr = do
+    beginQuote  <- oneOf "\"'"
+    s           <- many (noneOf [beginQuote])
+    char beginQuote
+    ret . packLBS . convert "UTF-8" "CP950" $ pack s
+
+matchStr :: Parser Match
+matchStr = fmap (mkMatch . packLBS . convert "UTF-8" "CP950") str
+
+mkMatch :: Value -> Match
+mkMatch s = MkMatch $ S.init (s `S.append` S.singleton '\0')
+
+packLBS :: ByteString -> S.ByteString
+packLBS = S.concat . toChunks
+
+labelStr :: Parser Label
+labelStr = fmap (toLabel . packLBS) str
+
+str :: Parser ByteString
+str = do
+    char '"'
+    s <- many (noneOf ['"'])
+    char '"'
+    ret $ pack s
+
+quotedValue :: Parser Value
+quotedValue = do
+    beginQuote  <- oneOf "\"'"
+    s           <- many (noneOf [beginQuote])
+    char beginQuote
+    ret $ S.pack s
diff --git a/src/Text/PageIO/Run.hs b/src/Text/PageIO/Run.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO/Run.hs
@@ -0,0 +1,52 @@
+module Text.PageIO.Run where
+import Data.Maybe
+import Text.PageIO.Types
+import System.IO
+import Data.ByteString.Unsafe
+import Data.ByteString.Lazy.Internal (defaultChunkSize)
+import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as L
+
+readPages :: FilePath -> IO [Page]
+readPages fn = openBinaryFile fn ReadMode >>= hReadPages
+
+hReadPages :: Handle -> IO [Page]
+hReadPages fh = do
+    hSetBinaryMode fh True
+    sz <- hFileSize fh
+    -- Cutoff is 64MB; we map the data directly to memory if it's less than that amount
+    if sz > 64 * 1024 * 1024
+        then hReadPagesLazy fh
+        else hReadPagesStrict fh (fromEnum sz)
+
+hReadPagesLazy :: Handle -> IO [Page]
+hReadPagesLazy fh = do
+    hSetBuffering fh (BlockBuffering (Just defaultChunkSize))
+    content <- L.hGetContents fh
+    return $ case map (S.concat . L.toChunks) (L.split '\x0C' content) of
+        []      -> []
+        (hd:tl) -> map (MkPage . map dropCR . S.lines) (hd:map (S.tail . S.dropWhile (/= '\n')) tl)
+    where
+    dropCR x
+        | S.null x          = S.copy x
+        | S.last x == '\r'  = S.copy (S.init x)
+        | otherwise         = S.copy x
+
+hReadPagesStrict :: Handle -> Int -> IO [Page]
+hReadPagesStrict fh sz = do
+    hSetBuffering fh (BlockBuffering (Just sz))
+    content <- S.hGet fh sz
+    case S.split '\x0C' content of
+        []      -> return []
+        (hd:tl) -> do
+            let pages = map (MkPage . map dropCR . S.lines) (hd:map (S.tail . S.dropWhile (/= '\n')) tl)
+            length (pageLines $ last pages) `seq` unsafeFinalize content
+            return pages
+    where
+    dropCR x
+        | S.null x          = S.copy x
+        | S.last x == '\r'  = S.copy (S.init x)
+        | otherwise         = S.copy x
+
+putPage :: Page -> IO ()
+putPage = mapM_ S.putStrLn . pageLines
diff --git a/src/Text/PageIO/Transform.hs b/src/Text/PageIO/Transform.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO/Transform.hs
@@ -0,0 +1,325 @@
+{-# LANGUAGE RecordPuns, ParallelListComp, PatternGuards #-}
+{-# OPTIONS -fno-warn-name-shadowing #-}
+
+module Text.PageIO.Transform where
+import Data.Maybe
+import Data.Monoid
+import Data.Char (isDigit)
+import Data.Function (on)
+import Data.List (find, inits, tails, sortBy, groupBy)
+import Text.Printf
+import qualified Text.PageIO.LabelMap as LM
+import qualified Data.ByteString.Char8 as S
+
+import Text.PageIO.Types
+import Text.PageIO.Extract (extractPage, SheetResult(..), BlockResult(..), Area)
+
+type Doc = [Page]
+
+type ValueMap = LabelMap [Value]
+data AppliedVariable = MkAppliedVariable
+    { avRow     :: Row
+    , avCol     :: Col
+    , avValue   :: Value
+    }
+    deriving (Show, Eq, Ord)
+
+data Slot = MkSlot
+    { slotSize      :: Row
+    , slotBlocks    :: [Label]
+    }
+    deriving (Eq, Ord, Show)
+
+type Ordered a = ([OrderBy (Maybe Value)], a)
+
+data BlockData = MkBlockData
+    { dataSize      :: Row
+    , dataAreas     :: [Ordered Area]
+    }
+    deriving (Eq, Ord, Show)
+
+instance Monoid BlockData where
+    mempty = MkBlockData (error "impossible") []
+    mappend x y = x{ dataAreas = dataAreas x ++ dataAreas y }
+    mconcat []  = mempty
+    mconcat xs  = MkBlockData
+        { dataSize  = dataSize (head xs)
+        , dataAreas = concatMap dataAreas xs
+        }
+
+type PageCapacity = [Slot]
+type FitAttempt = LabelMap BlockData
+
+-- The actual data bound to that area.
+type PageBinding = LabelMap [Area]
+
+-- Turn a list of page into pages grouped by results
+transformPages :: Sheet -> [Page] -> [Doc]
+transformPages sheet pages = map (makeDoc sheet) docGroups
+    where
+    docGroups = case sheetGroupBy sheet of
+        []      -> [resultAndPages]
+        lbls    -> groupBy ((==) `on` docKeys) resultAndPages
+            where
+            docKeys (res, _) = map (`LM.lookup` resultFields res) lbls
+    resultAndPages = 
+        [ (res, page)
+        | Just res  <- map (extractPage sheet) pages
+        | page      <- pages
+        ]
+
+-- Using Sheet+Page as template to rewrite a page
+-- First, rewrite SheetResult to eliminate all Variable fields
+-- Next, populate all fields
+-- Finally, populate frames with blocks and space-ify the rest of the frame lines
+--
+-- First try fitting everything on the last page.
+-- All frames must be consumed by blocks mentioned on that page.
+-- If it won't fit, then retry with the last two pages, etc.
+--
+-- Oh, and we re-extract the result pages to fill in vars! What joy!
+--
+-- XXX - If data would expand, then maybe repeat the first page indefinitely?
+--
+makeDoc :: Sheet -> [(SheetResult, Page)] -> Doc
+makeDoc sheet resultAndPages = case find (isJust . fst) pageBindings of
+    Just (Just bindings, boundPages) -> fillVariables sheet
+        [ makePage sheet b p
+        | b <- bindings
+        | p <- boundPages
+        ]
+    _  -> error "Impossible - cannot bind?"
+    where
+    results             = map fst resultAndPages
+    pages               = map snd resultAndPages
+    orders              = sheetBlockOrderBys sheet
+    (capacity, attempt) = foldr (doResult sheet orders) ([], mempty) results 
+    capacityTails       = repeatTails capacity
+    pageTails           = repeatTails pages
+    pageBindings        = 
+        [ (tryFit pc sortedAttempt, pages)
+        | pc    <- capacityTails
+        | pages <- pageTails
+        ]
+    sortedAttempt       = fmap (\dat -> dat{ dataAreas = sortBy (compare `on` fst) $ dataAreas dat }) attempt
+
+-- Given "abc", generate ["", "c", "bc", "abc", "aabc", "aaabc", "aaaabc"...]
+repeatTails :: [a] -> [[a]]
+repeatTails [] = []
+repeatTails orig@(x:xs) = reverse (tails xs) ++ map (++ orig) infinitePrefixes
+    where
+    infinitePrefixes = inits (repeat x)
+
+-- We now calculate the applied vars for each page
+fillVariables :: Sheet -> Doc -> Doc
+fillVariables sheet pages =
+    [ fillPageVariables appliedVars p
+    | p             <- pages
+    | appliedVars   <- map applyVariable ([1..] `zip` valueMaps)
+    ]
+    where
+    vars        = sheetVariableFields sheet
+    valueMaps   = map makeValueMap results
+    docVals     = LM.unionsWith (++) valueMaps
+    results     = map (maybe (error "Roundtrip failed!") id . extractPage sheet) pages
+    applyVariable :: (Int, ValueMap) -> LabelMap AppliedVariable
+    applyVariable (pageNum, pageVals) = LM.mapMaybeWithKey applyOneVariable vars
+        where
+        applyOneVariable :: Label -> Field -> Maybe AppliedVariable
+        applyOneVariable lbl MkField{ fieldBox, fieldVariable }
+            | Just var <- fieldVariable
+            , LM.member lbl pageVals  = Just MkAppliedVariable
+                { avRow     = boxTop fieldBox
+                , avCol     = boxLeft fieldBox
+                , avValue   = getVar var
+                }
+            | otherwise                 = Nothing
+            where
+            len = boxRight fieldBox - boxLeft fieldBox + 1
+            valOf :: Scope -> Label -> [Value]
+            valOf scope lbl = maybe [] id $ LM.lookup lbl vals
+                where
+                vals = case scope of
+                    SDoc    -> docVals
+                    SPage   -> pageVals
+            getVar VPage                = formatNumber pageNum
+            getVar (VSum scope label)   = formatDotted $ sum (map parseVal $ valOf scope label)
+            getVar (VCount scope label) = formatNumber $ length (valOf scope label)
+            getVar (VLiteral lit)       = lit `S.append` S.replicate (len - S.length lit) ' '
+            formatNumber = S.pack . printf ("%" ++ show len ++ "d")
+            formatDotted n = S.pack $ (replicate pad ' ') ++ dottedStr ++ ".00"
+                where
+                pad         = len - length dottedStr - 3
+                str         = show n
+                dottedStr   = reverse (addDot $ reverse str)
+                addDot (x:y:z:rest@(_:_))   = (x:y:z:',':addDot rest)
+                addDot xs                   = xs
+            parseVal :: Value -> Int
+            parseVal val = case S.readInt (S.filter isDigit (S.takeWhile (/= '.') val)) of
+                Just (num, _)   -> num
+                _               -> 0
+
+makeValueMap :: SheetResult -> ValueMap
+makeValueMap MkSheetResult{ resultFields, resultBlocks } = LM.unionsWith (++) (fieldMap:blockMaps)
+    where
+    fieldMap  = fmap (:[]) resultFields
+    blockMaps :: [ValueMap]
+    blockMaps = map makeBlockValueMap $ LM.elems resultBlocks
+    makeBlockValueMap :: BlockResult -> ValueMap
+    makeBlockValueMap (MkBlockResult avs) = LM.unionsWith (++) maps
+        where
+        maps :: [LabelMap [Value]]
+        maps = map (fmap (:[]) . snd) avs
+
+-- Now comes the fun part.
+-- For each frame, see if any of its blocks are there.
+-- If yes, concat them and pain the rest white.
+makePage :: Sheet -> PageBinding -> Page -> Page
+makePage MkSheet{ sheetFrames } binding page = foldl makeFrame page sheetFrames
+    where
+    makeFrame page MkFrame{ frameBox, frameBlocks }
+        | null frameBindings = page
+        | otherwise          = pageReplaced
+        where
+        pageCleared   = clearArea frameBox page
+        pageReplaced  = replaceArea frameBox (concat frameBindings) pageCleared
+        frameBindings = 
+            [ fromJust result
+            | frameLabel <- LM.keys frameBlocks
+            , let result = LM.lookup frameLabel binding
+            , isJust result
+            ]
+
+-- Start with 
+replaceArea :: Box -> [Area] -> Page -> Page
+replaceArea _ [] page = page
+replaceArea box@MkBox{ boxTop, boxLeft } (area:rest) page = replaceArea box' rest page'
+    where
+    box'  = box{ boxTop = boxTop + areaRows area}
+    page' = fillArea boxTop boxLeft area page
+
+clearArea :: Box -> Page -> Page
+clearArea MkBox{ boxTop, boxLeft, boxBottom, boxRight } (MkPage lns) = MkPage $ before ++ cleared ++ after
+    where
+    (before, rest)  = splitAt (boxTop-1) lns
+    (middle, after) = splitAt (boxBottom-boxTop+1) rest
+    cleared         = map (fillLine boxLeft . ((,) whiteSpace)) middle
+    whiteSpace      = S.replicate (boxRight-boxLeft+1) ' '
+
+{-# INLINE fillArea #-}
+fillArea :: Row -> Col -> Area -> Page -> Page
+fillArea row col (MkPage areaLines) (MkPage lns) = MkPage $ before ++ replaced ++ after
+    where
+    (before, rest)  = splitAt (row-1) lns
+    (middle, after) = splitAt (length areaLines) rest
+    replaced        = map (fillLine col) (areaLines `zip` middle)
+
+{-# INLINE fillLine #-}
+fillLine :: Col -> (Value, Value) -> Value
+fillLine col (areaLine, origLine) = S.concat [before, areaLine, after]
+    where
+    origLinePadded
+        | padLength <= 0    = origLine
+        | otherwise         = origLine `S.append` S.replicate padLength ' ' 
+    padLength       = S.length origLine - (col + areaLength - 1)
+    (before, rest)  = S.splitAt (col-1) origLinePadded
+    after           = S.drop areaLength rest
+    areaLength      = S.length areaLine
+
+doResult :: Sheet -> LabelMap [OrderBy Label] -> SheetResult -> ([PageCapacity], FitAttempt)
+            -> ([PageCapacity], FitAttempt)
+doResult MkSheet{ sheetFrames } orders MkSheetResult{ resultBlocks } (pcs, att) = (pc:pcs, att')
+    where
+    pc              = map frameToSlot framesOccured
+    framesOccured   = filter (labelOccured . frameBlocks) sheetFrames
+    labelOccured lm = any (`LM.member` lm) resultLabels
+    resultLabels    = LM.keys resultBlocks
+    att'            = LM.unionsWith mappend [att, LM.mapMaybeWithKey blockToData resultBlocks]
+    blockToData lbl (MkBlockResult lms) = case areas of 
+        []              -> Nothing
+        ((_, area):_)   -> Just MkBlockData
+            { dataSize  = areaRows area
+            , dataAreas = areas
+            }
+        where
+        orderFrom = case LM.lookup lbl orders of
+            Just orderBys   -> \vals -> map (fmap (`LM.lookup` vals)) orderBys
+            Nothing         -> const []
+        areas = [ (orderFrom vals, area) | (area, vals) <- lms ]
+    frameToSlot MkFrame{ frameBox, frameBlocks } = MkSlot
+        { slotSize   = boxBottom frameBox - boxTop frameBox + 1
+        , slotBlocks = LM.keys frameBlocks
+        }
+
+areaRows :: Area -> Row
+areaRows (MkPage lns) = length lns
+
+fillPageVariables :: LabelMap AppliedVariable -> Page -> Page
+fillPageVariables avs page = foldl fillOneVar page (LM.elems avs)
+    where
+    fillOneVar page MkAppliedVariable{ avRow, avCol, avValue }
+        = fillArea avRow avCol (valueToArea avValue) page
+
+valueToArea :: Value -> Area
+valueToArea val = MkPage [val]
+
+sheetVariableFields :: Sheet -> LabelMap Field
+sheetVariableFields MkSheet{ sheetFrames, sheetFields } = LM.unions filteredMaps
+    where
+    filteredMaps = map (LM.filter (isJust . fieldVariable)) fieldMaps
+    fieldMaps = sheetFields : concatMap frameVariableFields sheetFrames
+    frameVariableFields frame@MkFrame{ frameBox } = map blockVariableFields blocks
+        where
+        blocks    = LM.elems (frameBlocks frame)
+        rowOffset = boxTop frameBox - 1
+        colOffset = boxLeft frameBox - 1
+        blockVariableFields = fmap adjustField . blockFields
+        adjustField field@MkField{ fieldBox = MkBox{ boxTop, boxLeft, boxBottom, boxRight } } = field
+            { fieldBox = MkBox
+                { boxTop    = boxTop      + rowOffset
+                , boxLeft   = boxLeft     + colOffset
+                , boxBottom = boxBottom   + rowOffset
+                , boxRight  = boxRight    + colOffset
+                }
+            }
+
+sheetBlockOrderBys :: Sheet -> LabelMap [OrderBy Label]
+sheetBlockOrderBys MkSheet{ sheetFrames } = LM.unions (map frameBlockOrderBys sheetFrames)
+    where
+    frameBlockOrderBys MkFrame{ frameBlocks } = LM.fromList
+        [ (lbl, order) | (lbl, order@(_:_)) <- LM.toList (fmap blockOrderBy frameBlocks) ]
+
+-- Each try is on a list of Frame Capacities
+-- Each frame capacity is a number of rows, and the label of blocks it can consume
+-- We try it with the total number of blocks
+
+tryFit :: [PageCapacity] -> FitAttempt -> Maybe [PageBinding]
+tryFit pcs att = go pcs ([], att)
+    where
+    go []     (bindings, att)
+        | all (null . dataAreas) (LM.elems att) = Just (reverse bindings)
+        | otherwise                             = Nothing
+    go (p:ps) (bindings, att) = go ps ((bnd:bindings), att')
+        where
+        (bnd, att') = fitOnePage p (mempty, att)
+
+fitOnePage :: [Slot] -> (PageBinding, FitAttempt) -> (PageBinding, FitAttempt)
+fitOnePage [] x     = x
+fitOnePage (s:ss) x = fitOnePage ss $ fitOneSlot s x
+
+fitOneSlot :: Slot -> (PageBinding, FitAttempt) -> (PageBinding, FitAttempt)
+fitOneSlot slot@MkSlot{ slotSize, slotBlocks } x@(binding, att) = case slotBlocks of
+    []      -> x
+    (b:bs)  -> case LM.lookup b att of
+        Just dat@MkBlockData{ dataSize, dataAreas } ->
+            let consumed     = min (length dataAreas) (slotSize `div` dataSize)
+                consumedSize = consumed * dataSize
+                newData      = dat{ dataAreas = drop consumed dataAreas }
+                newAttempt   = LM.insert b newData att
+                newBinding   = LM.insertWith (++) b (map snd $ take consumed dataAreas) binding
+                newSlot      = slot
+                    { slotSize   = slotSize - consumedSize
+                    , slotBlocks = bs
+                    }
+             in fitOneSlot newSlot (newBinding, newAttempt)
+        _   -> fitOneSlot slot{ slotBlocks = bs } x
diff --git a/src/Text/PageIO/Types.hs b/src/Text/PageIO/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PageIO/Types.hs
@@ -0,0 +1,120 @@
+module Text.PageIO.Types (module Text.PageIO.Types, module Text.PageIO.LabelMap) where
+import Text.PageIO.LabelMap (LabelMap, Label, toLabel, fromLabel)
+import Data.ByteString.Internal (inlinePerformIO, memcmp, ByteString(..))
+import Foreign.Ptr
+import Foreign.ForeignPtr
+
+newtype Page = MkPage { pageLines :: [Value] }
+    deriving (Show, Eq, Ord)
+
+type Col = Int
+type Row = Int
+type FractionDigits = Int
+
+data FieldFormat = FGeneral | FNumeric FractionDigits | FDate
+    deriving (Show, Eq, Ord)
+
+type Value       = ByteString
+
+data Box = MkBox
+    { boxLeft   :: Col
+    , boxTop    :: Row
+    , boxRight  :: Col
+    , boxBottom :: Row
+    }
+    deriving (Show, Eq, Ord)
+
+data Sheet = MkSheet
+    { sheetBox      :: Box
+    , sheetPatterns :: LabelMap Pattern
+    , sheetFields   :: LabelMap Field
+    , sheetFrames   :: [Frame]
+    , sheetGroupBy  :: [Label]
+--  , sheetPositioning          :: CharPos | GridPos
+--  , sheetUseBlockSortPriority :: Bool
+    }
+    deriving (Show, Eq, Ord)
+
+data Pattern = MkPattern
+    { patternBox            :: Box
+    , patternMatch          :: Match
+    , patternUseWildcards   :: Bool
+    }
+    deriving (Show, Eq, Ord)
+
+data Scope = SPage | SDoc
+    deriving (Show, Eq, Ord)
+
+data Variable
+    = VPage
+    | VSum{ vScope :: Scope, vLabel :: Label }
+    | VCount{ vScope :: Scope, vLabel :: Label }
+    | VLiteral{ vValue :: Value }
+    deriving (Show, Eq, Ord)
+
+data Field = MkField
+    { fieldBox              :: Box
+    , fieldVariable         :: Maybe Variable
+    , fieldKeepSpaces       :: Bool
+    , fieldFormat           :: FieldFormat
+    }
+    deriving (Show, Eq, Ord)
+
+data Frame = MkFrame
+    { frameBox              :: Box
+    , frameBlocks           :: LabelMap Block
+    }
+    deriving (Show, Eq, Ord)
+
+data Operator = ONot Operator | OContains | OEq | OEndsWith | OStartsWith
+    deriving (Show, Eq, Ord)
+
+data Filter = MkFilter
+    { filterField       :: Label
+    , filterOperator    :: Operator
+    , filterMatch       :: Match
+    }
+    deriving (Show, Eq, Ord)
+
+data OrderBy a = DAscending a | DDescending a
+    deriving (Show, Eq)
+
+instance Functor OrderBy where
+    fmap f (DAscending x)   = DAscending (f x)
+    fmap f (DDescending x)  = DDescending (f x)
+
+instance Ord a => Ord (OrderBy a) where
+    compare (DAscending x)  (DAscending y)  = compare x y
+    compare (DDescending x) (DDescending y) = compare y x
+    compare DAscending{}    _               = LT
+    compare _               _               = GT
+
+data Block = MkBlock
+    { blockLines            :: Row
+    , blockPatterns         :: LabelMap Pattern
+    , blockFields           :: LabelMap Field
+    , blockOrderBy          :: [OrderBy Label]
+    , blockFilterBy         :: [Filter]
+--  , blockRule             :: Rule
+--  , blockSortPriority     :: Priority
+    }
+    deriving (Show, Eq, Ord)
+
+newtype Match = MkMatch { matchValue :: Value }
+    deriving (Show, Eq, Ord)
+
+{-# INLINE matches #-}
+matches :: Value -> Match -> Bool
+matches (PS x1 s1 l1) (MkMatch (PS x2 s2 l2))
+    | l2 > l1   = False
+    | otherwise = inlinePerformIO $
+        withForeignPtr x1 $ \p1 ->
+            withForeignPtr x2 $ \p2 -> do
+                let valuePtr    = p1 `plusPtr` s1
+                    matchPtr    = p2 `plusPtr` s2
+                    sz          = fromIntegral l2
+                    maxOffset   = l1 - l2
+                    go n = if n > maxOffset then return False else do
+                        rv <- memcmp matchPtr (valuePtr `plusPtr` n) sz
+                        if rv == 0 then return True else go (n+1)
+                 in go 0