diff --git a/demo/MidiRead.hs b/demo/MidiRead.hs
--- a/demo/MidiRead.hs
+++ b/demo/MidiRead.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  MidiRead
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009-2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -23,7 +23,9 @@
 import MidiDatatypes
 
 import Data.ParserCombinators.KangarooWriter
+import Data.ParserCombinators.Kangaroo.Utils
 
+
 import Control.Applicative
 import Control.Monad
 import Data.Bits
@@ -40,41 +42,26 @@
    putStrLn w
    either error return a
     
-{-
 
-logMsg :: String -> MidiParser ()
-logMsg = tell . ("\n" ++)
-
-logPos :: String -> MidiParser a -> MidiParser a
-logPos s p = do 
-  p1 <- position
-  ans <- p
-  p2 <- position
-  logMsg $ unwords [show p1, s, show p2]
-  return ans
-
-logBound :: String -> MidiParser a -> MidiParser a
-logBound s p = do 
-  b <- upperBound
-  logMsg $ unwords [ s, "region boundary", show b ]
-  p
-
--}
-
 --------------------------------------------------------------------------------
 -- 
 
-
+-- Not sure about this ... 
+(-*-) :: MidiParser a -> String -> MidiParser a
+(-*-) = substError
     
 midiFile :: MidiParser MidiFile  
-midiFile = mprogress MidiFile trackCount header (countS `flip` track)
+midiFile = printHexAll >> mprogress MidiFile trackCount header (countS `flip` track)
   where
     trackCount :: Header -> Int 
     trackCount (Header _ n _) = fromIntegral n
 
 header :: MidiParser Header  
-header = Header <$> (assertString "MThd"  *> assertWord32 (6::Int) *> format)
-                <*> word16be             <*> timeDivision 
+header = Header <$> (assertString "MThd"                -*- "header"
+                 *> assertWord32 (6::Int)               -*- "length"
+                 *> format                              -*- "format")
+                <*> word16be                            -*- "num tracks"
+                <*> timeDivision                        -*- "time division"
 
 countS :: Int -> MidiParser a -> MidiParser (Seq a)
 countS = genericCount (<|) S.empty 
@@ -87,8 +74,7 @@
 trackHeader = assertString "MTrk" >> word32be
 
 getMessages :: Word32 -> MidiParser (Seq Message)
-
-getMessages i = alfineRelative 0 (fromIntegral i) messages
+getMessages i = restrict "messages" Alfermata (fromIntegral i) messages
   where    
     messages = genericRunOn (<|) S.empty message
 
diff --git a/demo/MidiText.hs b/demo/MidiText.hs
--- a/demo/MidiText.hs
+++ b/demo/MidiText.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  MidiText
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009-2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -16,54 +16,35 @@
 
 
 module MidiText (
-    -- * Print a readable text representation
-    printMidi, ppMidiFile,
-    
-    ppHeader, ppMessage,
-  
+    -- * Print a midi file to stdout
+    printMidi
+
   ) where
 
 
 import MidiDatatypes
-
-import qualified Data.Foldable as F
-import Numeric
-import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint.JoinPrint hiding ( length )
 
 
-printMidi :: MidiFile -> IO ()
-printMidi = putStrLn . render . ppMidiFile 
-
+import qualified Data.Foldable as F
+import Data.Word
 
+void :: Monad m => m a -> m ()
+void mf = mf >> return ()
 
 
-integral :: Integral a => a -> Doc
-integral = integer . fromIntegral
-
-infixl 6 `hyph`, `dblhyph`
-
-hyph :: Doc -> Doc -> Doc
-x `hyph` y         = x <> text " - " <> y
-
-dblhyph :: Doc -> Doc -> Doc
-x `dblhyph` y         = x <> text " -- " <> y
-
-ppHex :: Integral a => a -> Doc
-ppHex i = text $ showHex i []
-
+printMidi :: MidiFile -> IO ()
+printMidi (MidiFile hdr tracks)  = do 
+   header hdr 
+   void $ F.foldlM (\i t -> track i t >> return (i+1)) 0 tracks
 
 
-ppMidiFile :: MidiFile -> Doc
-ppMidiFile (MidiFile header tracks)  = ppHeader header $$ tdoc $$ empty
-  where
-    tdoc = fst $ F.foldl fn (empty,0) tracks
-    fn (d,i) t = (d $$ prettyTrack t i, i+1)
-      
-ppHeader :: Header -> Doc
-ppHeader (Header hformat ntrks td) = 
-    text "[Header]" <+> ppHFormat hformat 
-                    `hyph` (integral ntrks <+> text "tracks") 
-                    `hyph` ppTimeDivision td
+header :: Header -> IO () 
+header (Header hformat ntrks td) = renderIO $ 
+    punctuate (text " - ") [ text "[Header]" <+> ppHFormat hformat
+                           , integral ntrks <+> text "tracks"
+                           , ppTimeDivision td
+                           ]
   
 ppHFormat :: HFormat -> Doc
 ppHFormat MF0  = text "Type 0"
@@ -74,87 +55,83 @@
 ppTimeDivision (FPS i)   = text "fps"   <+> integral i
 ppTimeDivision (TPB i)   = text "ticks" <+> integral i
 
-prettyTrack :: Track -> Int -> Doc
-prettyTrack (Track se) i = 
-    brackets (text "Track" <+> int i) $$ (snd $ F.foldl fn (0,empty) se)
+track :: Int -> Track -> IO ()
+track i (Track se) = do 
+    renderIO $ brackets (text "Track" <+> int i) 
+    void $ F.foldlM fn 0 se
   where
-    fn (gt,doc) msg@(dt,_)  = 
-      (gt+dt, doc $$ (padshow 8 (gt+dt) `hyph` ppMessage msg))    
+    fn gt (dt,evt)  = let (name,d) =  event evt in
+                      do { renderIO $ mkEvent gt dt name d 
+                         ; return (gt+dt)
+                         }
 
 
-ppMessage :: Message -> Doc
-ppMessage (dt,evt) = padshow 5 dt `hyph` ppEvent evt      
+mkEvent :: Word32 -> DeltaTime -> String -> Doc -> Doc
+mkEvent ot dt name rest = let s = text " - " in
+    punctuate s [ padl 10 ' ' (integral ot)
+                , padl 6  ' ' (integral dt)
+                , padr 20 ' ' (text name)
+                , rest]
 
+type EventDescr = (String,Doc)
 
-ppEvent :: Event -> Doc
-ppEvent (VoiceEvent e)   = ppVoiceEvent e
-ppEvent (SystemEvent e)  = text "sys"  `dblhyph` ppSystemEvent e
-ppEvent (MetaEvent e)    = text "meta" `dblhyph` ppMetaEvent e
 
-padshow :: Show a => Int -> a -> Doc
-padshow pad a = let s = show a ; dif = pad - length s in
-    text $ replicate dif ' ' ++ s 
-                  
+event :: Event -> EventDescr
+event (VoiceEvent e)   = voiceEvent e
+event (SystemEvent e)  = let (s,d) = systemEvent e in ("sys " ++s, d)
+event (MetaEvent e)    = let (s,d) = metaEvent e in ("meta " ++ s, d)
 
 
 fli :: (Integral a, Show a) => a -> Doc
-fli = padshow 3
+fli = padl 3 ' ' . integral
 
-ppVoiceEvent :: VoiceEvent -> Doc
-ppVoiceEvent (NoteOff ch nt vel)        = 
-    text "note-off" `hyph` fli ch `hyph` fli nt `hyph` fli vel
- 
-ppVoiceEvent (NoteOn ch nt vel)         =
-    text "note-on " `hyph` fli ch `hyph` fli nt `hyph` fli vel
-    
-ppVoiceEvent (NoteAftertouch ch nt val) = 
-    text "note-after-touch" `hyph` fli ch `hyph` fli nt `hyph` fli val
-    
-ppVoiceEvent (Controller ch ty val)     = 
-    text "ctlr" `hyph` fli ch `hyph` fli ty `hyph` fli val
-    
-ppVoiceEvent (ProgramChange ch num)     = 
-    text "pc" `hyph` fli ch `hyph` fli num
-    
-ppVoiceEvent (ChanAftertouch ch val)    = 
-    text "chan-after-touch" `hyph` fli ch `hyph` fli val
-      
-ppVoiceEvent (PitchBend ch val)         = 
-    text "pitch-bend" `hyph` fli ch `hyph` fli val
+voiceEvent :: VoiceEvent -> EventDescr
+voiceEvent (NoteOff ch nt vel)        = ("note-off",    dashInts [ch,nt,vel])
+voiceEvent (NoteOn ch nt vel)         = ("note-on",     dashInts [ch,nt,vel])
+voiceEvent (NoteAftertouch ch nt val) = ("note-after-touch", dashInts [ch,nt,val])
+voiceEvent (Controller ch ty val)     = ("ctlr",        dashInts [ch,ty,val])
+voiceEvent (ProgramChange ch num)     = ("pc",          dashInts [ch,num])
+voiceEvent (ChanAftertouch ch val)    = ("chan-after-touch", dashInts [ch,val])
+voiceEvent (PitchBend ch val)         = ("pitch-bend",  dashInts [fromIntegral ch,val])
 
   
 
-ppSystemEvent :: SystemEvent -> Doc
-ppSystemEvent (SysEx _ _)    = text "sysex"   -- system exclusive event - length x data
-ppSystemEvent (DataEvent i)  = text "data" <+> ppHex i
+systemEvent :: SystemEvent -> EventDescr
+systemEvent (SysEx _ _)    = ("sysex", empty)   
+systemEvent (DataEvent i)  = ("data",  oxhex2 i)
 
-ppMetaEvent :: MetaEvent -> Doc
-ppMetaEvent (TextEvent ty s)     = ppTextType ty `hyph` doubleQuotes (text s)
-ppMetaEvent (SequenceNumber i)   = text "sequence-number" `hyph` integral i
-ppMetaEvent (ChannelPrefix ch)   = text "channel-prefix"  `hyph` integral ch
-ppMetaEvent (EndOfTrack)         = text "end-of-track"
-ppMetaEvent (SetTempo mspqn)     = text "set-tempo" `hyph` integral mspqn  -- microseconds per quarter-note
-ppMetaEvent (SMPTEOffset h m s f sf) = 
-    text "smpte" `hyph` fli h `hyph` fli m `hyph` fli s `hyph` fli f `hyph` fli sf
-    
-ppMetaEvent (TimeSignature n d m ns) = 
-    text "time-sig" `hyph` fli n `hyph` fli d `hyph` fli m `hyph` fli ns
-    
-ppMetaEvent (KeySignature i sc)  = 
-    text "key-sig" `hyph` integral i `hyph` ppScaleType sc
-       
-ppMetaEvent (SSME i _)           = text "ssme" `hyph` ppHex i <+> text "..."
+metaEvent :: MetaEvent -> EventDescr
+metaEvent (TextEvent ty s)          = (textType ty, dquotes $ text s)
+metaEvent (SequenceNumber i)        = ("sequence-number", integral i)
+metaEvent (ChannelPrefix ch)        = ("channel-prefix",  integral ch)
+metaEvent (EndOfTrack)              = ("end-of-track", empty)
+metaEvent (SetTempo mspqn)          = ("set-tempo", integral mspqn)
+metaEvent (SMPTEOffset h m s f sf)  = ("smpte",     dashInts [h,m,s,f,sf])
+metaEvent (TimeSignature n d m ns)  = ("time-sig",  dashInts [n,d,m,ns])
+metaEvent (KeySignature i sc)       = ("key-sig", integral i `hyph` st) 
+     where st = text $ scaleType sc
+metaEvent (SSME i _)                = ("ssme",    oxhex8 i <+> text "...")
 
-ppScaleType :: ScaleType -> Doc
-ppScaleType MAJOR  = text "major"
-ppScaleType MINOR  = text "minor"
+dashInts :: Integral a => [a] -> Doc
+dashInts = punctuate (text " - ") . map fli
+
+
+scaleType :: ScaleType -> String
+scaleType MAJOR  = "major"
+scaleType MINOR  = "minor"
   
-ppTextType :: TextType -> Doc
-ppTextType GENERIC_TEXT         = text "generic-text" 
-ppTextType COPYRIGHT_NOTICE     = text "copyright-notice"  
-ppTextType SEQUENCE_NAME        = text "sequence-name"
-ppTextType INSTRUMENT_NAME      = text "instrument-name"
-ppTextType LYRICS               = text "lyrics"
-ppTextType MARKER               = text "marker"
-ppTextType CUE_POINT            = text "cue-point"
+textType :: TextType -> String
+textType GENERIC_TEXT         =  "generic-text" 
+textType COPYRIGHT_NOTICE     =  "copyright-notice"  
+textType SEQUENCE_NAME        =  "sequence-name"
+textType INSTRUMENT_NAME      =  "instrument-name"
+textType LYRICS               =  "lyrics"
+textType MARKER               =  "marker"
+textType CUE_POINT            =  "cue-point"
   
+
+infixl 6 `hyph`
+
+hyph :: Doc -> Doc -> Doc
+x `hyph` y         = x <> text " - " <> y
+
diff --git a/demo/PrintMidi.hs b/demo/PrintMidi.hs
--- a/demo/PrintMidi.hs
+++ b/demo/PrintMidi.hs
@@ -9,6 +9,7 @@
 
 module Main where
 
+
 import MidiRead
 import MidiText
 
diff --git a/kangaroo.cabal b/kangaroo.cabal
--- a/kangaroo.cabal
+++ b/kangaroo.cabal
@@ -1,12 +1,12 @@
 name:             kangaroo
-version:          0.1.0
+version:          0.2.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
 maintainer:       Stephen Tetley <stephen.tetley@gmail.com>
 homepage:         http://code.google.com/p/copperbox/
 category:         Parsing
-synopsis:         Random access binary combinator parser.
+synopsis:         Binary parsing with random access.
 description:
   Binary parsing with random access. The target file to be 
   parsed is loaded into memory at the start (represented as
@@ -24,10 +24,18 @@
   Hackage because I'm now using it with Hurdle which was already 
   on Hackage.
   .
+  Currently kangaroo is twinned with its own library of formatting
+  combinators, at some point this is likely to be put into its 
+  own package
+  .
   Changelog:
+  .
+  0.2.0 Changes to ParseMonad - parsing within a region simplified, 
+  temporarily added JoinPrint.
   . 
-  0.1.0 First version
-  
+  0.1.0 First version.
+  .
+
 build-type:         Simple
 stability:          half baked
 cabal-version:      >= 1.2
@@ -43,7 +51,7 @@
 library
   hs-source-dirs:     src
   build-depends:      base < 5,
-                      array >= 0.3.0.0 && < 0.4
+                      array >= 0.2.0.0 && < 0.4
 
   
   exposed-modules:
@@ -52,13 +60,19 @@
     Data.ParserCombinators.KangarooRWS,
     Data.ParserCombinators.KangarooState,
     Data.ParserCombinators.KangarooWriter,
+    Text.PrettyPrint.JoinPrint
+
+  other-modules:
     Data.ParserCombinators.Kangaroo.Combinators,
+    Data.ParserCombinators.Kangaroo.Debug,
     Data.ParserCombinators.Kangaroo.IEEEFloat,
     Data.ParserCombinators.Kangaroo.ParseMonad,
     Data.ParserCombinators.Kangaroo.Prim,
-    Data.ParserCombinators.Kangaroo.Utils
-
-  other-modules:
+    Data.ParserCombinators.Kangaroo.Region,
+    Data.ParserCombinators.Kangaroo.Utils,
+    Text.PrettyPrint.JoinPrint.Core,
+    Text.PrettyPrint.JoinPrint.HexDump,
+    Text.PrettyPrint.JoinPrint.JoinString
       
   extensions:
     
diff --git a/src/Data/ParserCombinators/Kangaroo.hs b/src/Data/ParserCombinators/Kangaroo.hs
--- a/src/Data/ParserCombinators/Kangaroo.hs
+++ b/src/Data/ParserCombinators/Kangaroo.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.Kangaroo
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009, 2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -19,17 +19,14 @@
     module Data.ParserCombinators.Kangaroo.Combinators
   , module Data.ParserCombinators.Kangaroo.ParseMonad
   , module Data.ParserCombinators.Kangaroo.Prim
-  , module Data.ParserCombinators.Kangaroo.Utils
   , Kangaroo
   , runKangaroo
   , parse
   ) where
 
 import Data.ParserCombinators.Kangaroo.Combinators
-import Data.ParserCombinators.Kangaroo.ParseMonad hiding (
-    getSt, putSt, modifySt ) -- TO SORT...
+import Data.ParserCombinators.Kangaroo.ParseMonad
 import Data.ParserCombinators.Kangaroo.Prim
-import Data.ParserCombinators.Kangaroo.Utils hiding ( (<:>), oo, ooo, oooo )
 
 
 type Kangaroo a = GenKangaroo () a
diff --git a/src/Data/ParserCombinators/Kangaroo/Debug.hs b/src/Data/ParserCombinators/Kangaroo/Debug.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/Debug.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.Debug
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Debug helpers
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.Debug
+  (
+    slowHexAll
+  
+  ) where
+
+
+import Text.PrettyPrint.JoinPrint
+
+import Data.Array.IO
+import Data.Word
+
+slowHexAll :: IOUArray Int Word8 -> IO ()
+slowHexAll arr = getElems arr  >>= \xs    -> 
+                 getBounds arr >>= \(s,e) -> putStrLn $ render $ hexdump s e xs
+
diff --git a/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs b/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs
--- a/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs
+++ b/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.Kangaroo.ParseMonad
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009-2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -18,47 +18,50 @@
   (
     GenKangaroo
   , ParseErr
-  
-  , getSt
-  , putSt
-  , modifySt
-  
+  , RegionCoda(..)      -- re-export
+  , RegionName          -- re-export
+    
   , getUserSt
   , putUserSt
   , modifyUserSt
 
-  , askEnv
   , throwErr
+  , liftIOAction
+  , withSuccess
   , runGenKangaroo
 
   , reportError
   , substError
+
+  -- * Primitive parsers
   , word8
   , checkWord8
   , opt 
+
+  -- * Query the cursor position
   , position
-  , regionEnd
+  , region
   , atEnd
   , lengthRemaining
-
-  -- * Parse within a /region/.
-  , dalpunto
-  , dalpuntoRelative
-  , advanceDalpunto
-  , advanceDalpuntoAbsolute
-
-  , alfine
-  , alfineRelative
-  , restrictAlfine
+  , regionSize
 
-  , alfermata
-  , alfermataRelative
-  , advanceAlfermata
-  , advanceAlfermataAbsolute
-  , restrictAlfermata 
+  -- * Parse within a region
+  , intraparse
+  , advance
+  , advanceRelative
+  , restrict
+  , restrictToPos
    
+  -- * Debug
+  , printHexAll
+  , printRegionStack 
+
   ) where
 
+import Data.ParserCombinators.Kangaroo.Debug
+import Data.ParserCombinators.Kangaroo.Region
+import Data.ParserCombinators.Kangaroo.Utils
+
 import Control.Applicative
 import Control.Monad
 import Data.Array.IO
@@ -70,13 +73,11 @@
 
 type ImageData = IOUArray Int Word8   -- Is Int big enough for index?
 
-data ArrIx = ArrIx { arr_ix_ptr :: !Int, arr_ix_end :: !Int }
-  deriving (Eq,Show) 
 
-type St    = ArrIx
-type Env   = ImageData
-  
+type St    = ParseStack
+type Env   = ImageData    
 
+
 -- Kangaroo is not a transformer as IO is always at the 
 -- \'bottom\' of the effect stack. Like the original Parsec it is
 -- parametric on user state (refered to as ust).
@@ -134,16 +135,50 @@
 -- is no inbuilt backtracking or support for list-of-successes.
 
 
-getSt :: GenKangaroo ust St
-getSt = GenKangaroo $ \_ st ust -> return (Right st, st, ust)
 
-putSt :: St -> GenKangaroo ust ()
-putSt st = GenKangaroo $ \_ _ ust -> return (Right (), st, ust)
 
-modifySt :: (St -> St) -> GenKangaroo ust ()
-modifySt f = GenKangaroo $ \_ st ust -> return (Right (), f st, ust)
+runGenKangaroo :: GenKangaroo ust a -> ust -> FilePath -> IO (Either ParseErr a,ust)
+runGenKangaroo p user_state filename = 
+    withBinaryFile filename ReadMode $ \ handle -> 
+      do { sz                 <- hFileSize handle
+         ; arr                <- newArray_ (0,fromIntegral $ sz-1)
+         ; rsz                <- hGetArray handle arr  (fromIntegral sz)
+         ; (ans,stk,ust)      <- runP p rsz arr
+         ; return (answer ans stk,ust)   
+         }
+  where 
+    runP (GenKangaroo x) upper arr = x arr st0 user_state  
+      where 
+        st0 = newStack 0 (upper-1) Alfine " -- file -- "
 
+    answer (Left err)  stk        = Left $ err 
+                                          ++ ('\n':'\n':printParseStack stk)
+    answer (Right ans) _          = Right ans
 
+
+
+throwErr  :: ParseErr -> GenKangaroo ust a
+throwErr msg = GenKangaroo $ \_ st ust -> return (Left msg, st, ust)
+
+askEnv    :: GenKangaroo ust Env
+askEnv    = GenKangaroo $ \env st ust -> return (Right env, st, ust)
+
+getSt     :: GenKangaroo ust St
+getSt     = GenKangaroo $ \_ st ust -> return (Right st, st, ust)
+
+putSt     :: St -> GenKangaroo ust ()
+putSt st  = GenKangaroo $ \_ _ ust -> return (Right (), st, ust)
+
+
+getPos    :: GenKangaroo ust Pos
+getPos    = liftM location getSt
+
+getEnd    :: GenKangaroo ust RegionEnd
+getEnd    = liftM regionEnd  getSt
+
+getStart  :: GenKangaroo ust RegionStart
+getStart  = liftM regionStart getSt
+
 getUserSt :: GenKangaroo ust ust
 getUserSt = GenKangaroo $ \_ st ust -> return (Right ust, st, ust)
 
@@ -154,59 +189,54 @@
 modifyUserSt f = GenKangaroo $ \_ st ust -> return (Right (), st, f ust)
 
 
+-- Modifying the position lets the parser go beyond the 
+-- end-of-file.
 
-askEnv :: GenKangaroo ust Env
-askEnv = GenKangaroo $ \env st ust -> return (Right env, st, ust)
+advancePos1 :: GenKangaroo ust ()
+advancePos1 = modifyPos (+1) 
 
+modifyPos :: (Pos -> Pos) -> GenKangaroo ust ()
+modifyPos f = GenKangaroo $ \_ st ust -> return (Right (), move f st, ust)
 
-throwErr :: String -> GenKangaroo ust a
-throwErr msg = GenKangaroo $ \_ st ust -> return (Left msg, st, ust)
 
-liftIOAction :: IO a -> GenKangaroo ust a
-liftIOAction ma = GenKangaroo $ \_ st ust -> 
-    ma >>= \a -> return (Right a, st, ust) 
 
+bracketRegion :: RegionInfo -> GenKangaroo ust a -> GenKangaroo ust a
+bracketRegion i = bracketM_ pushM popM 
+  where 
+    pushM       = getSt >>= \st -> case push i st of
+                     Left err -> throwErr $ getRegionError err
+                     Right stk -> putSt stk
 
+    popM         = getSt >>= \st -> putSt (pop st)
 
 
-runGenKangaroo :: GenKangaroo ust a -> ust -> FilePath -> IO (Either ParseErr a,ust)
-runGenKangaroo p user_state filename = 
-    withBinaryFile filename ReadMode $ \ handle -> 
-      do { sz          <- hFileSize handle
-         ; arr         <- newArray_ (0,fromIntegral $ sz-1)
-         ; rsz         <- hGetArray handle arr  (fromIntegral sz)
-         ; (ans,_,ust) <- runP p rsz arr
-         ; return (ans,ust)   
-         }
-  where 
-    runP (GenKangaroo x) upper arr = x arr (ArrIx 0 (upper-1)) user_state
+liftIOAction :: IO a -> GenKangaroo ust a
+liftIOAction ma = GenKangaroo $ \_ st ust -> 
+    ma >>= \a -> return (Right a, st, ust) 
 
 
 
 --------------------------------------------------------------------------------
 -- Helpers
 
-modifyIx :: (Int -> Int) -> GenKangaroo ust ()
-modifyIx f = modifySt $ \(ArrIx ix end) -> ArrIx (f ix) end
-
 --------------------------------------------------------------------------------
 -- 
 
 
 reportError :: ParseErr -> GenKangaroo ust a
 reportError s = do 
-    posn <- getSt
+    posn <- getPos
     throwErr $ s ++ posStr posn
   where
-    posStr (ArrIx pos end) = concat [ " absolute position "
-                                    , show pos
-                                    , " (0x" 
-                                    , showHex pos []
-                                    , "), region length "
-                                    , show end
-                                    ]
+    posStr pos  = concat [ " absolute position "
+                         , show pos
+                         , " (0x" 
+                         , showHex pos []
+                         , ")"
+                         ]
 
 
+
 substError :: GenKangaroo ust a -> ParseErr -> GenKangaroo ust a
 substError p msg = GenKangaroo $ \env st ust -> 
     (getGenKangaroo p) env st ust >>= \ ans -> 
@@ -214,205 +244,193 @@
         (Left _, st', ust')  -> return (Left msg, st', ust')
         okay                 -> return okay
 
+
+withSuccess :: Bool -> ParseErr -> GenKangaroo ust a -> GenKangaroo ust a
+withSuccess False msg _  = throwErr msg
+withSuccess True  _   mf = mf
+
+
+--------------------------------------------------------------------------------
+-- Primitive parsers
+
    
 word8 :: GenKangaroo ust Word8
 word8 = do
-    (ArrIx ix end)   <- getSt
+    ix               <- getPos
+    end              <- getEnd
     when (ix>end)    (reportError "word8")   -- test emphatically is (>) !
     arr              <- askEnv
     a                <- liftIOAction $ readArray arr ix
-    putSt $ ArrIx (ix+1) end
+    advancePos1
     return a
 
-
 checkWord8 :: (Word8 -> Bool) -> GenKangaroo ust (Maybe Word8)
 checkWord8 check = word8 >>= \ans ->
     if check ans then return $ Just ans
-                 else modifyIx (subtract 1) >> return Nothing
+                 else modifyPos (`subtract` 1) >> return Nothing
 
 
 
+
+
 -- no 'try' in Kangaroo... 
--- opt is the nearest to it, opt backtracks the cursor onm failure.
+-- opt is the nearest to it, opt backtracks the cursor on failure.
 opt :: GenKangaroo ust a -> GenKangaroo ust (Maybe a)
 opt p = GenKangaroo $ \env st ust -> (getGenKangaroo p) env st ust >>= \ ans -> 
     case ans of
       (Left _, _, ust')    -> return (Right Nothing, st, ust')
       (Right a, st', ust') -> return (Right $ Just a, st', ust')
 
-position :: GenKangaroo ust Int
-position = liftM arr_ix_ptr getSt
 
-regionEnd :: GenKangaroo ust Int
-regionEnd = liftM arr_ix_end getSt
-
-
-
-atEnd :: GenKangaroo ust Bool
-atEnd = getSt >>= \(ArrIx ix end) -> return $ ix >= end
-
-lengthRemaining :: GenKangaroo ust Int
-lengthRemaining = getSt >>= \(ArrIx ix end) -> 
-   let rest = end - ix in if rest < 0 then return 0 else return rest
-
 --------------------------------------------------------------------------------
--- The important ones parsing within a /region/ ...
+-- Querying position
 
--- Three useful final positions 
---
--- 1. dalpunto  - 'from the point'      
--- - Run the parser within a region and return to where you came
---   from.
---
--- 2. alfine    - 'to the end'     
--- - Run the parser within a region and jump to the right-end of 
---   the region after the parse.
+-- | 'position' : @-> cursor-position@
 --
--- 3. alfermata - 'to the stop'    
--- - Run the parser within a region, the cursor remains wherever 
---   the parse finished.
+-- Return the current cursor position
 --
-
-
+position :: GenKangaroo ust Int
+position = getPos
 
 
-assertSubsetRegion :: String -> Int -> Int -> GenKangaroo ust ()
-assertSubsetRegion fun_name start end = 
-    getSt >>= \(ArrIx pos endpos) -> step pos endpos 
-  where
-    step pos endpos | start < pos   = reportError $ 
-                                        backtrackErr start pos fun_name
-                    | end > endpos  = reportError $ 
-                                        tooFarErr end endpos fun_name
-                    | otherwise     = return ()
+-- | 'region' : @-> (region-start, cursor-position, region-end)@
+--
+-- Return the current parse region and the current position of 
+-- the cursor within it.
+-- 
+region   :: GenKangaroo ust (Int,Int,Int)
+region   = liftM3 (,,) getStart getPos getEnd
 
+-- region limits are inclusive so cursor is at the end 
+-- if the position is greater that the end location.
 
-backtrackErr :: Int -> Int -> String -> String  
-backtrackErr new_pos old_pos fun_name = concat
-    [ "Kangaroo.ParseMonad."
-    , fun_name
-    , " - cannot backtrack, " 
-    , show new_pos 
-    , " is before current position " 
-    , show old_pos
-    ]
+-- | 'atEnd' - is the cursor at the end of the current region?
+--
+atEnd :: GenKangaroo ust Bool
+atEnd = liftM2 (>) getPos getEnd
 
-tooFarErr :: Int -> Int -> String -> String
-tooFarErr new_end old_end fun_name = concat
-    [ "Kangaroo.ParseMonad."
-    , fun_name 
-    , " - new end point " 
-    , show new_end 
-    , " extends beyond the end of the current region "
-    , show old_end
-    ]
+-- | 'lengthRemaining' : @-> distance-to-region-end@
+--
+-- Distance from the current cursor position to the end of the
+-- current region
+--
+lengthRemaining :: GenKangaroo ust Int
+lengthRemaining = liftM2 fn getEnd getPos 
+  where  
+    fn a b | a <= b    = 0
+           | otherwise = a - b
 
 
--- Parser inside the supplied region, afterwards restore the
--- end of the /outer/ region and return to the initial position.
+-- | 'regionSize' : @-> region-length@
 --
-dalpuntoP :: String -> Int -> Int 
-                 -> GenKangaroo ust a 
-                 -> GenKangaroo ust a
-dalpuntoP fun_name start end p = do
-    st <- getSt 
-    assertSubsetRegion fun_name start end
-    putSt $ ArrIx start end
-    ans <- p
-    putSt st
-    return ans
-    
+-- Size of the current region.
+--
+regionSize :: GenKangaroo ust Int
+regionSize = liftM2 (-) getEnd getStart
 
 
--- | return to the start position - start x length
-dalpunto :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-dalpunto = dalpuntoP "dalpunto"
+--------------------------------------------------------------------------------
+-- The important ones parsing within a /region/ ...
 
 
--- | return to the start position - displacement x length
-dalpuntoRelative :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-dalpuntoRelative disp len p = getSt >>= \(ArrIx pos _) ->
-    dalpuntoP "dalpuntoRelative" (pos+disp) (pos+disp+len-1) p
 
--- | Advance the current position by the supplied distance.
-advanceDalpunto :: Int -> GenKangaroo ust p -> GenKangaroo ust p
-advanceDalpunto i p = getSt >>= \(ArrIx pos end) -> 
-    dalpuntoP "advanceDalpunto" (pos+i) end p
-
--- | Advance the current position to the supplied (absolute) 
--- position.
-advanceDalpuntoAbsolute :: Int -> GenKangaroo ust p -> GenKangaroo ust p
-advanceDalpuntoAbsolute i p = getSt >>= \(ArrIx _ end) -> 
-    dalpuntoP "advanceDalpuntoAbsolute" i end p
+-- | 'intraparse' : @name * coda * abs_region_start * region_length * parser -> parser@
+--
+-- Create a new region within the current one and run the 
+-- supplied parser. The cursor position is moved to the start 
+-- of the new region. The value of @coda@ determines where the 
+-- cursor is positioned after a successful parse. 
+--
+-- 'intraparse' throws a parse error if the supplied 
+-- absolute-region-start is not located within the current region,
+-- or if the right-boundary of the new region 
+-- (@abs_region_start + region_length@) extends beyond the 
+-- right-boundary of the current region.
+--
 
+intraparse :: RegionName -> RegionCoda -> RegionStart -> Int 
+           -> GenKangaroo ust a 
+           -> GenKangaroo ust a
+intraparse name coda intra_start len p = 
+    bracketRegion (newRegion intra_start len coda name) p
+             
 
--- Parse inside the supplied region, afterwards go to the end of
--- the supplied region and restore the end of the /outer/ region.
+-- | 'advance' : @name * coda * abs_region_start * parser -> parser@
+-- 
+-- A variation of 'intraparse' - the new region starts at the 
+-- supplied @abs_region_start@ and continues to the end of the 
+-- current region.
 --
-alfineP :: String -> Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-alfineP fun_name start end p = do
-    ArrIx _ prev_end <- getSt 
-    assertSubsetRegion fun_name start end
-    putSt $ ArrIx start end
-    ans <- p
-    putSt $ ArrIx (end+1) prev_end
-    return ans
+-- 'advance' throws a parse error if the new start position is 
+-- not within the current region.
+--
+ 
+advance :: RegionName -> RegionCoda -> Int 
+        -> GenKangaroo ust a 
+        -> GenKangaroo ust a
+advance name coda intra_start p = getEnd >>= \end -> 
+    intraparse name coda intra_start (end - intra_start) p
 
 
--- | alfine - parse to the end
-alfine :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-alfine = alfineP "alfine"
+-- | 'advanceRelative' : @name * coda * distance * parser -> parser@
+--
+-- A variation of 'advance' - the start of the new region is
+-- calculated from the @current-cursor-position@ + the supplied
+-- @distance@.
+--
+-- 'advanceRelative' throws a parse error if the new start 
+-- position is not within the current region.
+--
 
--- | finish at the right of the region - displacement x length
-alfineRelative :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-alfineRelative disp len p = getSt >>= \(ArrIx pos _) ->
-    alfineP "alfineRelative" (pos+disp) (pos+disp+len-1) p
+advanceRelative :: RegionName -> RegionCoda -> Int
+                -> GenKangaroo ust a 
+                -> GenKangaroo ust a
+advanceRelative name coda dist p = getPos >>= \pos -> 
+    intraparse name coda (pos+dist) dist p
 
 
-restrictAlfine :: Int -> GenKangaroo ust p -> GenKangaroo ust p
-restrictAlfine dist_to_end p = getSt >>= \(ArrIx pos _) -> 
-    alfineP "restrictAlfine" pos (pos + dist_to_end) p
-    
+-- | 'restrict' : @ name * coda * distance * parser -> parser@
+-- 
+-- A variation of 'intraparse' - create a new region as a 
+-- restriction of the current one and run the supplied parser. 
+-- The new region starts at the current coursor position, the 
+-- right-boundary is restricted to the @current-cursor-position@ 
+-- + the supplied @distance@.
+--
+-- 'restrict' throws a parse error if the right-boundary of the 
+-- new region extends beyond the current region.
+--
+restrict :: RegionName -> RegionCoda -> Int 
+         -> GenKangaroo ust a 
+         -> GenKangaroo ust a
+restrict name coda len p = getPos >>= \pos -> 
+    intraparse name coda pos len p
 
 
--- Parser inside the supplied region, afterwards restore the end 
--- of the /outer/region but keep the cursor in at the current 
--- position.
+-- | 'restrictToPos' : @region-name * coda * abs-end-pos * parser -> parser@
 --
-alfermataP :: String -> Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-alfermataP fun_name start end p = do
-    ArrIx _ prev_end    <- getSt 
-    assertSubsetRegion fun_name start end
-    putSt $ ArrIx start end
-    ans <- p
-    ArrIx curr_pos _    <- getSt
-    putSt $ ArrIx curr_pos prev_end 
-    return ans
- 
--- | alfermata - parse to the /sign/ i.e. wherever the supplied 
--- parser stops within the supplied region. At the end of the
--- parse restore the outer region.
+-- A variantion of 'restrict' - the new region takes the current 
+-- cursor position for the left-boundary and the supplied 
+-- absolute-end-position (@abs-end-pos@) as the right-boundary. 
 --
-alfermata :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-alfermata = alfermataP "alfermata"
+-- 'restrictToPos' throws a parse error if the @abs-end-pos@ 
+-- extends beyond the right-boundary of the current region. 
+--
+restrictToPos :: RegionName -> RegionCoda -> Int 
+              -> GenKangaroo ust a 
+              -> GenKangaroo ust a
+restrictToPos name coda abs_pos p = getPos >>= \pos -> 
+    intraparse name coda pos (abs_pos-pos) p
 
 
-alfermataRelative :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
-alfermataRelative disp len p = getSt >>= \(ArrIx pos _) ->
-    alfermataP "alfermataRel" (pos+disp) (pos+disp+len-1) p
 
+--------------------------------------------------------------------------------
+-- Debug
 
--- | Advance the current position by the supplied distance.
-advanceAlfermata :: Int -> GenKangaroo ust p -> GenKangaroo ust p
-advanceAlfermata i p = getSt >>= \(ArrIx pos end) -> 
-    alfermataP "advanceAlfermata" (pos+i) end p
+printHexAll         :: GenKangaroo ust ()
+printHexAll         = askEnv >>= liftIOAction . slowHexAll
 
--- | Advance the current position to the supplied (absolute) 
--- position.
-advanceAlfermataAbsolute :: Int -> GenKangaroo ust p -> GenKangaroo ust p
-advanceAlfermataAbsolute i p = getSt >>= \(ArrIx _ end) -> 
-    alfermataP "advanceAlfermataAbsolute" i end p
+printRegionStack    :: GenKangaroo ust ()
+printRegionStack    = getSt >>= liftIOAction . putStrLn . printParseStack
 
-restrictAlfermata :: Int -> GenKangaroo ust p -> GenKangaroo ust p
-restrictAlfermata dist_to_end p = getSt >>= \(ArrIx pos _) ->
-    alfermataP "restrictAlfermata" pos (pos + dist_to_end) p
+                
diff --git a/src/Data/ParserCombinators/Kangaroo/Region.hs b/src/Data/ParserCombinators/Kangaroo/Region.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/Region.hs
@@ -0,0 +1,193 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.Region
+-- Copyright   :  (c) Stephen Tetley 2009-2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Data types to manage parse regions
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.Region
+  (
+  -- * Types
+    RegionCoda(..)
+  , RegionStart
+  , RegionEnd
+  , RegionName
+  , Pos
+  , RegionInfo
+  , ParseStack
+  , RegionError(..)
+
+  -- * Operations
+  , newStack
+  , newRegion
+
+  , regionStart
+  , regionEnd
+  , push
+  , pop
+  , move1
+  , move
+  , location
+
+  , printParseStack
+  
+  ) where
+
+
+import Text.PrettyPrint.JoinPrint  hiding ( length )
+
+
+-- | 'RegionCoda' - represents three useful final positions:
+--
+-- 1. dalpunto  - 'from the point'      
+-- - Run the parser within a region and return to where you came
+--   from.
+--
+-- 2. alfermata - 'to the stop'    
+-- - Run the parser within a region, the cursor remains wherever 
+--   the parse finished.
+--
+-- 3. alfine    - 'to the end'     
+-- - Run the parser within a region and jump to the right-end of 
+--   the region after the parse.
+--
+data RegionCoda = Dalpunto | Alfermata | Alfine
+  deriving (Enum,Eq,Show)
+
+
+type RegionStart = Int
+type RegionEnd   = Int
+type RegionName  = String
+
+type Pos         = Int
+
+-- | 'RegionInfo' contains the (inclusive) bounds of a region 
+-- and the \'coda action\' to take after parsing has finished.
+--
+
+data RegionInfo  = RegionInfo 
+        { region_start_incl   :: !RegionStart
+        , region_end_incl     :: !RegionEnd
+        , region_coda         :: !RegionCoda
+        , region_name         :: !String
+        }
+  deriving (Eq,Show)
+
+
+
+-- | 'ParseStack' is a non empty list of RegionInfo structures.
+--
+data ParseStack = P0 Pos RegionInfo | Pn Pos RegionInfo ParseStack
+  deriving (Eq,Show)
+
+-- These two might change...
+
+newtype RegionError = RegionError { getRegionError :: String }
+  deriving (Eq,Show)
+
+
+
+--------------------------------------------------------------------------------
+
+mapTop :: (RegionInfo -> a) -> ParseStack -> a
+mapTop f (P0 _ info)   = f info
+mapTop f (Pn _ info _) = f info
+
+modifyPos :: (Pos -> Pos) -> ParseStack -> ParseStack
+modifyPos f (P0 p info)     = P0 (f p) info
+modifyPos f (Pn p info stk) = Pn (f p) info stk
+
+validBounds :: RegionStart -> RegionEnd -> ParseStack -> Bool
+validBounds s e stk = s >= regionStart stk && e <= regionEnd stk
+
+infos :: ParseStack -> [RegionInfo]
+infos (P0 _ info)     = [info]
+infos (Pn _ info stk) = info : infos stk
+
+regionError :: RegionName -> RegionStart -> RegionEnd -> ParseStack 
+            -> RegionError
+regionError nm s e stk = step (regionStart stk) (regionEnd stk) 
+  where
+    step rs re | s < rs && e > re = mkMsg nm "past the bounds" (s,e) (rs,re)
+               | s < rs           = mkMsg nm "past the left"   (s,e) (rs,re)
+               | e > re           = mkMsg nm "past the right"  (s,e) (rs,re)
+               | otherwise        = RegionError $ 
+                                      "regionError called on invalid data."
+
+mkMsg :: RegionName -> String -> (Int,Int) -> (Int,Int) -> RegionError
+mkMsg name descr new old  = RegionError $ 
+    unwords [ "The new region"
+            , ('\'' : name ++ "'")
+            , show new
+            , "extends"
+            , descr
+            , "of the old region"
+            , show old
+            ]
+
+--------------------------------------------------------------------------------
+-- Exported operations
+
+regionStart     :: ParseStack -> Int
+regionStart     = mapTop region_start_incl
+
+regionEnd       :: ParseStack -> Int
+regionEnd       = mapTop region_end_incl
+
+
+newStack :: RegionStart -> RegionEnd -> RegionCoda -> RegionName -> ParseStack
+newStack s e coda name = P0 0 (RegionInfo s e coda name)
+
+newRegion :: RegionStart -> Int -> RegionCoda -> RegionName -> RegionInfo
+newRegion s len coda name = RegionInfo s (s+len-1) coda name
+
+
+push :: RegionInfo -> ParseStack -> Either RegionError ParseStack
+push info@(RegionInfo s e _ name) stk 
+    | validBounds s e stk = Right $ Pn s info stk
+    | otherwise           = Left  $ regionError name s e stk
+
+
+pop :: ParseStack -> ParseStack
+pop (P0 p info)      = P0 p info
+pop (Pn p info stk)  = case region_coda info of
+    Dalpunto  -> stk
+    Alfermata -> modifyPos (const p) stk
+    Alfine    -> modifyPos (const $ region_end_incl info) stk
+
+-- Moving will always succeed, so it is possible to move beyond 
+-- the end-of-file.
+                         
+move1 :: ParseStack -> ParseStack
+move1 = modifyPos (+1)
+
+move :: (Pos -> Pos) -> ParseStack -> ParseStack
+move = modifyPos
+
+location :: ParseStack -> Int
+location (P0 p _)   = p
+location (Pn p _ _) = p
+
+printParseStack :: ParseStack -> String
+printParseStack pstack = unlines $ map (render . fn) stk
+  where
+    stk             = infos pstack
+    (w1,w4)         = onSnd (length . show) $ foldr phi (0,0) stk
+    phi info (a,b)  = (max a (length $ region_name info), max b $ region_end_incl info)
+    onSnd f (a,b)   = (a, f b)
+
+    fn        :: RegionInfo -> Doc
+    fn rgn    =  padl w1 ' ' (text $ region_name rgn)
+             <+> padl w4 ' ' (int  $ region_start_incl rgn)
+             <+> padl w4 ' ' (int  $ region_end_incl rgn)
+    
+
diff --git a/src/Data/ParserCombinators/Kangaroo/Utils.hs b/src/Data/ParserCombinators/Kangaroo/Utils.hs
--- a/src/Data/ParserCombinators/Kangaroo/Utils.hs
+++ b/src/Data/ParserCombinators/Kangaroo/Utils.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.Kangaroo.Utils
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009-2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -19,7 +19,12 @@
     (<:>)
   , pairA
   , mprogress
+  , bracketM
+  , bracketM_
 
+  , unfoldrM 
+
+
   -- * Specs
   , oo
   , ooo
@@ -57,7 +62,7 @@
 
 
 import Control.Applicative
-
+import Control.Monad 
 import Data.Bits
 import Data.Int
 import Data.Word
@@ -78,6 +83,26 @@
 -- needs renaming...
 mprogress :: Monad m => (a -> c -> d) -> (a -> b) -> m a -> (b -> m c) -> m d
 mprogress comb f ma mb = ma >>= \a -> mb (f a) >>= \b -> return $ comb a b
+
+
+
+bracketM :: Monad m => m a -> (a -> m b) -> (a -> m c) -> m c
+bracketM pre post mf = do 
+    a   <- pre
+    ans <- mf a
+    _   <- post a
+    return ans
+
+bracketM_ :: Monad m => m a -> m b -> m c -> m c
+bracketM_ pre post mf = pre >> mf >>= \ans -> post >> return ans
+
+
+
+unfoldrM      :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a]
+unfoldrM mf b  = mf b >>= maybe (return []) sk
+  where
+    sk (a,st)  = liftM (a:) $ unfoldrM mf st
+
 
 -- specs - defined in my package data-aviary but defined here to 
 -- avoid a dependency
diff --git a/src/Data/ParserCombinators/KangarooRWS.hs b/src/Data/ParserCombinators/KangarooRWS.hs
--- a/src/Data/ParserCombinators/KangarooRWS.hs
+++ b/src/Data/ParserCombinators/KangarooRWS.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.KangarooRWS
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009, 2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -19,7 +19,6 @@
     module Data.ParserCombinators.Kangaroo.Combinators
   , module Data.ParserCombinators.Kangaroo.ParseMonad
   , module Data.ParserCombinators.Kangaroo.Prim
-  , module Data.ParserCombinators.Kangaroo.Utils
   , Kangaroo
   , parse
   , runKangaroo
@@ -37,8 +36,7 @@
 import Data.ParserCombinators.Kangaroo.Combinators
 import Data.ParserCombinators.Kangaroo.ParseMonad
 import Data.ParserCombinators.Kangaroo.Prim
-import Data.ParserCombinators.Kangaroo.Utils hiding ( (<:>), oo, ooo, oooo )
-import qualified Data.ParserCombinators.Kangaroo.Utils as Specs
+import Data.ParserCombinators.Kangaroo.Utils
 
 import Control.Monad
 import Data.Monoid
@@ -62,7 +60,7 @@
       -> st 
       -> FilePath 
       -> IO (Either ParseErr a)
-parse = liftM fst `Specs.oooo` evalKangaroo 
+parse = liftM fst `oooo` evalKangaroo 
 
 runKangaroo :: Monoid w 
             => Kangaroo r w st a 
@@ -80,7 +78,7 @@
              -> st 
              -> FilePath 
              -> IO (Either ParseErr a,w)
-evalKangaroo = liftM fn `Specs.oooo` runKangaroo where
+evalKangaroo = liftM fn `oooo` runKangaroo where
     fn (a,w,_) = (a,w)
 
 -- state, no answer
@@ -90,7 +88,7 @@
              -> st 
              -> FilePath 
              -> IO st
-execKangaroo = liftM state3 `Specs.oooo` runKangaroo 
+execKangaroo = liftM state3 `oooo` runKangaroo 
  
 
 put :: st -> Kangaroo r w st ()
diff --git a/src/Data/ParserCombinators/KangarooReader.hs b/src/Data/ParserCombinators/KangarooReader.hs
--- a/src/Data/ParserCombinators/KangarooReader.hs
+++ b/src/Data/ParserCombinators/KangarooReader.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.KangarooReader
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009, 2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -19,7 +19,6 @@
     module Data.ParserCombinators.Kangaroo.Combinators
   , module Data.ParserCombinators.Kangaroo.ParseMonad
   , module Data.ParserCombinators.Kangaroo.Prim
-  , module Data.ParserCombinators.Kangaroo.Utils
   , Kangaroo
   , parse
   , runKangaroo
@@ -30,7 +29,7 @@
 import Data.ParserCombinators.Kangaroo.Combinators
 import Data.ParserCombinators.Kangaroo.ParseMonad
 import Data.ParserCombinators.Kangaroo.Prim
-import Data.ParserCombinators.Kangaroo.Utils hiding ( (<:>), oo, ooo, oooo )
+import Data.ParserCombinators.Kangaroo.Utils
 
 import Control.Monad ( liftM )
 
diff --git a/src/Data/ParserCombinators/KangarooState.hs b/src/Data/ParserCombinators/KangarooState.hs
--- a/src/Data/ParserCombinators/KangarooState.hs
+++ b/src/Data/ParserCombinators/KangarooState.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.KangarooState
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009, 2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -19,7 +19,6 @@
     module Data.ParserCombinators.Kangaroo.Combinators
   , module Data.ParserCombinators.Kangaroo.ParseMonad
   , module Data.ParserCombinators.Kangaroo.Prim
-  , module Data.ParserCombinators.Kangaroo.Utils
   , Kangaroo
   , parse
   , runKangaroo
@@ -35,8 +34,7 @@
 import Data.ParserCombinators.Kangaroo.Combinators
 import Data.ParserCombinators.Kangaroo.ParseMonad
 import Data.ParserCombinators.Kangaroo.Prim
-import Data.ParserCombinators.Kangaroo.Utils hiding ( (<:>), oo, ooo, oooo )
-import qualified Data.ParserCombinators.Kangaroo.Utils as Specs
+import Data.ParserCombinators.Kangaroo.Utils
 
 import Control.Monad
 
@@ -50,11 +48,11 @@
 
 -- answer, no state
 evalKangaroo :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a)
-evalKangaroo = liftM fst `Specs.ooo` runKangaroo
+evalKangaroo = liftM fst `ooo` runKangaroo
 
 -- state, no answer
 execKangaroo :: Kangaroo st a -> st -> FilePath -> IO st
-execKangaroo = liftM snd `Specs.ooo` runKangaroo
+execKangaroo = liftM snd `ooo` runKangaroo
 
 
 put :: st -> Kangaroo st ()
diff --git a/src/Data/ParserCombinators/KangarooWriter.hs b/src/Data/ParserCombinators/KangarooWriter.hs
--- a/src/Data/ParserCombinators/KangarooWriter.hs
+++ b/src/Data/ParserCombinators/KangarooWriter.hs
@@ -3,7 +3,7 @@
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.ParserCombinators.KangarooWriter
--- Copyright   :  (c) Stephen Tetley 2009
+-- Copyright   :  (c) Stephen Tetley 2009, 2010
 -- License     :  BSD3
 --
 -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
@@ -19,7 +19,6 @@
     module Data.ParserCombinators.Kangaroo.Combinators
   , module Data.ParserCombinators.Kangaroo.ParseMonad
   , module Data.ParserCombinators.Kangaroo.Prim
-  , module Data.ParserCombinators.Kangaroo.Utils
   , Kangaroo
   , parse
   , runKangaroo
@@ -30,7 +29,6 @@
 import Data.ParserCombinators.Kangaroo.Combinators
 import Data.ParserCombinators.Kangaroo.ParseMonad
 import Data.ParserCombinators.Kangaroo.Prim
-import Data.ParserCombinators.Kangaroo.Utils hiding ( (<:>), oo, ooo, oooo )
 
 import Data.Monoid
 
diff --git a/src/Text/PrettyPrint/JoinPrint.hs b/src/Text/PrettyPrint/JoinPrint.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PrettyPrint/JoinPrint.hs
@@ -0,0 +1,25 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Text.PrettyPrint.JoinPrint
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Printing with /join-strings/.
+--
+--------------------------------------------------------------------------------
+
+module Text.PrettyPrint.JoinPrint
+  ( 
+    module Text.PrettyPrint.JoinPrint.Core
+  , module Text.PrettyPrint.JoinPrint.HexDump  
+  ) where
+
+import Text.PrettyPrint.JoinPrint.Core
+import Text.PrettyPrint.JoinPrint.HexDump
+
diff --git a/src/Text/PrettyPrint/JoinPrint/Core.hs b/src/Text/PrettyPrint/JoinPrint/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PrettyPrint/JoinPrint/Core.hs
@@ -0,0 +1,247 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Text.PrettyPrint.JoinPrint.Core
+-- Copyright   :  (c) Stephen Tetley 2009-2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Printing with /join-strings/.
+--
+--------------------------------------------------------------------------------
+
+module Text.PrettyPrint.JoinPrint.Core
+  ( 
+    Doc
+  , empty
+  , null
+  , length
+
+  , (<>)
+  , (<+>)
+  , (<%>)
+  , vcat
+  , hcat
+  , hsep
+
+  , text
+  , char
+  , int
+  , integer
+  , integral
+
+  , sglspace
+  , dblspace
+  , comma
+  , semicolon
+
+
+  , punctuate
+  , enclose
+  , squotes
+  , dquotes
+  , parens
+  , brackets
+  , braces
+  , angles
+
+  , lparen
+  , rparen
+  , lbracket
+  , rbracket
+  , lbrace
+  , rbrace
+  , langle
+  , rangle
+
+
+  , replicateChar
+  , spacer
+
+
+  , padl
+  , padr
+  , truncl 
+  , truncr
+  
+  , render
+  , renderIO
+  
+  ) where
+
+
+import Text.PrettyPrint.JoinPrint.JoinString ( JoinString, (++) )
+import qualified Text.PrettyPrint.JoinPrint.JoinString as JS
+
+import Prelude hiding ( (++), null, length )
+
+newtype Doc = Doc { getDoc :: JoinString }
+
+instance Show Doc where
+  show = render
+        
+infixr 5 <%>
+infixr 6 <>, <+>
+
+
+empty :: Doc
+empty = Doc $ JS.empty
+
+null :: Doc -> Bool
+null = JS.null . getDoc 
+
+
+-- | length on a Doc is O(1).
+length :: Doc -> Int
+length = JS.length . getDoc
+
+
+(<>) :: Doc -> Doc -> Doc
+Doc a <> Doc b = Doc $ a ++ b
+
+(<+>) :: Doc -> Doc -> Doc
+Doc a <+> Doc b = Doc (a ++ JS.cons1 ' ' b)
+
+(<%>) :: Doc -> Doc -> Doc
+Doc a <%> Doc b = Doc (a ++ JS.cons1 '\n' b)
+
+vcat :: [Doc] -> Doc
+vcat = foldr (<%>) empty
+
+hcat :: [Doc] -> Doc
+hcat = foldr (<>) empty
+
+hsep :: [Doc] -> Doc
+hsep = foldr (<+>) empty
+
+
+
+text :: String -> Doc
+text = Doc . (JS.text)
+
+char :: Char -> Doc
+char = Doc . (JS.text) . return
+
+int :: Int -> Doc
+int  = text . show
+
+integer :: Integer -> Doc
+integer = text . show
+
+integral :: Integral a => a -> Doc
+integral = integer . fromIntegral
+
+sglspace :: Doc
+sglspace = char ' '
+
+dblspace :: Doc
+dblspace = text "  "
+
+comma :: Doc
+comma = char ','
+
+semicolon :: Doc
+semicolon = char ';'
+
+
+--------------------------------------------------------------------------------
+
+punctuate :: Doc -> [Doc] -> Doc
+punctuate _ []     = empty
+punctuate _ [x]    = x
+punctuate s (x:xs) = x <> s <> punctuate s xs
+
+
+enclose :: Doc -> Doc -> Doc -> Doc
+enclose l r d = l <> d <> r
+
+squotes :: Doc -> Doc
+squotes = enclose (char '\'') (char '\'')
+
+dquotes :: Doc -> Doc
+dquotes = enclose (char '"') (char '"')
+
+
+parens :: Doc -> Doc
+parens = enclose lparen rparen
+
+brackets :: Doc -> Doc
+brackets = enclose lbracket rbracket
+
+braces :: Doc -> Doc
+braces = enclose lbrace rbrace
+
+angles :: Doc -> Doc
+angles = enclose langle rangle
+
+
+
+lparen :: Doc
+lparen = char '('
+
+rparen :: Doc
+rparen = char ')'
+
+lbracket :: Doc
+lbracket = char '['
+
+rbracket :: Doc
+rbracket = char ']'
+
+lbrace :: Doc
+lbrace = char '{'
+
+rbrace :: Doc
+rbrace = char '}'
+
+langle :: Doc
+langle = char '<'
+
+rangle :: Doc
+rangle = char '>'
+
+
+--------------------------------------------------------------------------------
+
+replicateChar :: Int -> Char -> Doc
+replicateChar i = Doc . (JS.text) . replicate i
+
+spacer :: Int -> Doc
+spacer = replicateChar `flip` ' '
+
+
+padl :: Int -> Char -> Doc -> Doc
+padl i c d = step (length d) where
+  step dl | dl >= i   = d
+          | otherwise = replicateChar (i-dl) c <> d 
+
+padr :: Int -> Char -> Doc -> Doc
+padr i c d = step (length d) where
+  step dl | dl >= i   = d
+          | otherwise = d <> replicateChar (i-dl) c
+
+
+truncl :: Int -> Doc -> Doc
+truncl i d = step (length d) where
+    step dl | dl > i    = Doc $ JS.dropLeft i (getDoc d)
+            | otherwise = d
+
+truncr :: Int -> Doc -> Doc
+truncr i d = step (length d) where
+    step dl | dl > i    = Doc $ JS.dropRight i (getDoc d)
+            | otherwise = d
+
+
+-- | Rendering is simple because there is no notion of fitting.
+--
+render :: Doc -> String
+render = JS.toString . getDoc
+
+
+
+renderIO :: Doc -> IO ()
+renderIO = putStrLn . JS.toString . getDoc
diff --git a/src/Text/PrettyPrint/JoinPrint/HexDump.hs b/src/Text/PrettyPrint/JoinPrint/HexDump.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PrettyPrint/JoinPrint/HexDump.hs
@@ -0,0 +1,156 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Text.PrettyPrint.JoinPrint.HexDump
+-- Copyright   :  (c) Stephen Tetley 2009-2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Hex dumps
+--
+--------------------------------------------------------------------------------
+
+module Text.PrettyPrint.JoinPrint.HexDump
+  ( 
+    hex
+  , hex2
+  , hex4
+  , hex8
+  
+  , oxhex
+  , oxhex2
+  , oxhex4
+  , oxhex8
+
+  , hexdump
+
+
+  ) where
+
+
+import Text.PrettyPrint.JoinPrint.Core
+
+import Data.Char
+import Data.List ( unfoldr )
+import Data.Word
+import Numeric
+
+import Prelude hiding ( length )
+import qualified Prelude as Pre
+
+
+asterix :: String -> Doc
+asterix = text . map (const '*')
+
+
+
+
+-- | 'hex' : @i -> Doc@
+-- 
+-- Print @i@ as hexadecimal, no zero padding. 
+--
+-- Negative numbers are printed as a string of asterisks.
+-- 
+hex :: Integral a => a -> Doc
+hex i | i >= 0    = text $ showHex i []
+      | otherwise = asterix $ showHex (abs i) []
+
+
+
+
+hex2 :: Word8 -> Doc
+hex2 = padl 2 '0' . text . ($ []) . showHex
+
+hex4 :: Word16 -> Doc
+hex4 = padl 4 '0' . text . ($ []) . showHex
+
+hex8 :: Word32 -> Doc
+hex8 = padl 8 '0' . text . ($ []) . showHex
+
+-- | 'oxhex' : @pad-length * i -> Doc@
+--
+-- Print @i@ in hexadecimal, padding with \'0\' to the supplied 
+-- @pad-length@ and prefixing with \"0x\".
+--
+-- Negative numbers are printed as a string of asterisks.
+-- 
+oxhex  :: Integral a => Int -> a -> Doc
+oxhex plen i 
+    | i >= 0    = text "0x" <> padl plen '0' (text $ showHex i [])
+    | otherwise = text "0x" <> padl plen '*' (asterix $ showHex (abs i) [])
+
+oxhex2 :: Word8 -> Doc
+oxhex2 = (text "0x" <>) . hex2
+
+oxhex4 :: Word16 -> Doc
+oxhex4 = (text "0x" <>) . hex4
+
+oxhex8 :: Word32 -> Doc
+oxhex8 = (text "0x" <>) . hex8
+
+--------------------------------------------------------------------------------
+
+-- This would be better if it didn't need a list in the first 
+-- place (i.e. it could use an array directly)...
+
+hexdump :: Int -> Int -> [Word8] -> Doc
+hexdump start end bs = 
+    vcat $ aZipWith (hexLine True c1_width, hexLine False c1_width) 
+                    index_nums
+                    segs
+  where
+    segs       = segment16 (16 - (start `mod` 16)) bs
+    c1_width   = 2 +  (Pre.length $ showHex end "")
+    index_nums = lineNumbers start end
+
+aZipWith :: (a -> b -> c, a -> b -> c) -> [a] -> [b] -> [c]
+aZipWith (f,g) (x:xs) (y:ys) = f x y : zipWith g xs ys
+aZipWith _     _      _      = []
+
+
+
+--------------------------------------------------------------------------------
+
+type Width   = Int
+type LineNum = Int 
+
+hexLine :: Bool -> Width -> LineNum -> [Word8] -> Doc 
+hexLine is_initial c1_max n xs = c1 <+> empty <+> c2 <+> c3
+  where
+    c1  = padl c1_max ' ' (hex n)
+    c2  = columnPad is_initial (16*3)   $ hsep $ map hex2 xs
+    c3  = columnPad is_initial 16       $ text $ map printable xs
+
+
+-- Default is to pad to the right...
+--
+columnPad :: Bool -> Width -> Doc -> Doc
+columnPad pad_left w d = step $ length d where
+    step l | l < w = if pad_left then padl w ' ' d else padr w ' ' d
+    step _         = d       
+                   
+
+lineNumbers :: Int -> Int -> [Int]
+lineNumbers s e = unfoldr phi $ s `div` 16 where
+   phi n | n > e     = Nothing
+         | otherwise = Just (n,n+16) 
+
+
+
+-- Show 16 bytes per line...
+segment16 :: Int -> [a] -> [[a]]
+segment16 initial ls = let (top,rest) = splitAt initial ls
+                       in top : unfoldr phi rest
+  where
+    phi [] = Nothing
+    phi cs = let (xs,rest) = splitAt 16 cs in Just (xs,rest)
+
+
+printable :: Word8 -> Char
+printable = fn . chr . fromIntegral where 
+  fn c | isPrint c = c
+       | otherwise = '.'
diff --git a/src/Text/PrettyPrint/JoinPrint/JoinString.hs b/src/Text/PrettyPrint/JoinPrint/JoinString.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/PrettyPrint/JoinPrint/JoinString.hs
@@ -0,0 +1,195 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Text.PrettyPrint.JoinPrint.JoinString
+-- Copyright   :  (c) Stephen Tetley 2009, 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Strings represented as /join lists/ for efficient append.
+--
+--------------------------------------------------------------------------------
+
+module Text.PrettyPrint.JoinPrint.JoinString
+  ( 
+    JoinString
+
+  , toString
+  , empty
+  , text 
+  , cons
+  , snoc
+  , cons1
+  , (++)
+  , length  
+  , null
+  , foldr
+  , foldl
+  , takeLeft  
+  , takeRight
+  , dropLeft
+  , dropRight
+
+  ) where
+
+
+import Data.Monoid
+
+
+import qualified Prelude as Pre
+import Prelude hiding ( (++), foldl, foldr, length, null )
+
+
+data JoinString = Empty 
+                | Leaf Int String 
+                | Tree Int JoinString JoinString
+  deriving (Eq,Show)
+
+--------------------------------------------------------------------------------
+
+instance Monoid JoinString where
+  mempty  = Empty
+  mappend = (++)
+
+
+empty :: JoinString
+empty = Empty
+
+-- | Build a JoinString from a string
+--
+text :: String -> JoinString
+text [] = Empty
+text s  = Leaf (Pre.length s) s
+
+cons :: String -> JoinString -> JoinString
+cons s xs = text s ++ xs
+
+snoc :: JoinString -> String -> JoinString
+snoc xs s = xs ++ text s
+
+-- | Character cons (potentially) efficient if the join string
+-- is a leaf.
+-- 
+cons1 :: Char -> JoinString -> JoinString
+cons1 c Empty        = Leaf 1 [c]
+cons1 c (Leaf i s)   = Leaf (i+1) (c:s)
+cons1 c (Tree i t u) = Tree (i+1) (cons1 c t) u
+
+
+-- | Concatenate two join strings. Unlike (++) on regular lists, 
+-- concatenation on join strings is (relatively) cheap hence the 
+-- name /join list/.
+--
+(++) :: JoinString -> JoinString -> JoinString
+Empty ++ ys    = ys
+xs    ++ Empty = xs
+xs    ++ ys    = Tree (length xs + length ys)  xs ys
+
+
+length :: JoinString -> Int
+length Empty        = 0
+length (Leaf i _)   = i
+length (Tree i _ _) = i
+
+null :: JoinString -> Bool
+null Empty = True
+null _     = False
+
+
+toString :: JoinString -> String
+toString = foldr (flip (Pre.++)) ""
+
+
+-- | Right-associative fold of a JoinString.
+--
+foldr :: (String -> b -> b) -> b -> JoinString -> b
+foldr _ e Empty         = e
+foldr f e (Leaf _ xs)   = f xs e
+foldr f e (Tree _ t u)  = foldr f (foldr f e t) u
+
+
+-- | Left-associative fold of a JoinString.
+--
+foldl :: (b -> String -> b) -> b -> JoinString -> b
+foldl _ e Empty         = e
+foldl f e (Leaf _ xs)   = f e xs
+foldl f e (Tree _ t u)  = foldl f (foldl f e u) t
+
+-- | 'takeLeft'  flattens the join-string.
+--
+takeLeft :: Int -> JoinString -> JoinString
+takeLeft = build `oo` step where
+    build (i,xs) | i <= 0           = Empty
+                 | otherwise        = Leaf i xs
+
+    step :: Int -> JoinString -> (Int,String)
+    step _ Empty                    = (0,"")
+    step n (Leaf i xs)  | n >= i    = (i,xs) 
+                        | otherwise = (n,Pre.take n xs)
+    step n (Tree _ t u)             = let (i,ls) = step n t in
+                                      if i<n then let (j,rs) = step (n-i) u in 
+                                                  (i+j,ls Pre.++ rs)
+                                             else (i,ls)
+ 
+-- | 'takeRight'  flattens the join-string.
+--
+takeRight :: Int -> JoinString -> JoinString
+takeRight = build `oo` step where
+    build (i,xs) | i <= 0           = Empty
+                 | otherwise        = Leaf i xs
+
+    step :: Int -> JoinString -> (Int,String)
+    step _ Empty                    = (0,"")
+    step n (Leaf i xs)  | n >= i    = (i,xs) 
+                        | otherwise = (n,ltr n xs)
+    step n (Tree _ t u)             = let (i,rs) = step n u in
+                                      if i<n then let (j,ls) = step (n-i) t in 
+                                                  (i+j,ls Pre.++ rs)
+                                             else (i,rs)
+ 
+ 
+
+
+ltr :: Int -> [a] -> [a]
+ltr n = ($ []) . snd . Pre.foldr fn (0,id) where
+  fn e (i,f) | i < n      = (i+1, (e:) . f)
+             | otherwise  = (i,f)
+
+
+
+dropLeft :: Int -> JoinString -> JoinString
+dropLeft = snd `oo` step where
+    step n Empty                    = (n,Empty)
+    step n (Leaf a xs)  | n >= a    = (n-a,Empty)       -- drop all
+                        | otherwise = (0,Leaf (a-n) (drop n xs))
+    step n (Tree a t u) | n >= a    = (n-a,Empty)
+                        | otherwise = let (n',t') = step n t in 
+                                      if n' > 0 then step n' u
+                                                else (0,mkTree (a-n) t' u)
+    mkTree _ Empty u    = u
+    mkTree n t     u    = Tree n t u
+
+
+dropRight :: Int -> JoinString -> JoinString 
+dropRight = snd `oo` step where
+    step n Empty                    = (n,Empty)
+    step n (Leaf a xs)  | n >= a    = (n-a,Empty)       -- drop all
+                        | otherwise = (0,Leaf (a-n) (take (a-n) xs))
+    step n (Tree a t u) | n >= a    = (n-a,Empty)
+                        | otherwise = let (n',u') = step n u in
+                                      if n' > 0 then step n' t
+                                                else (0, mkTree (a-n) t u')
+    
+    mkTree _ t Empty    = t
+    mkTree n t u        = Tree n t u 
+
+
+--------------------------------------------------------------------------------
+-- 
+
+oo :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+oo f g r s = f (g r s)
diff --git a/test/Picklers.hs b/test/Picklers.hs
--- a/test/Picklers.hs
+++ b/test/Picklers.hs
@@ -17,7 +17,7 @@
 module Picklers where
 
 
-import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString as BS
 import Data.Char
 import Data.List ( foldl' )
 import Data.Word
@@ -36,15 +36,22 @@
   where rpkl = BS.reverse $ getRevBS pkl 
 
 
-cons :: Char -> Pickle -> Pickle
+cons :: Word8 -> Pickle -> Pickle
 cons c = RevBS . BS.cons c . getRevBS 
 
 putCString :: String -> Pickle -> Pickle
-putCString s pkl = putWord8 0 $ foldl' (flip cons) pkl s
+putCString s pkl = putWord8 0 $ foldl' (flip putChar8) pkl s
 
 putWord8 :: Word8 -> Pickle -> Pickle
-putWord8 w = cons (chr $ fromIntegral w)
+putWord8 = cons 
 
+putChar8 :: Char -> Pickle -> Pickle
+putChar8 ch = cons (fromIntegral $ ord ch)
+
 -- TODO 
 cstring :: String -> Pickle
 cstring = putCString `flip` empty 
+
+
+string :: String -> Pickle
+string = foldl' (flip putChar8) empty