diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2008 Stephen Peter Tetley
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,4 @@
+#!/usr/bin/env runhaskell
+
+import Distribution.Simple
+main = defaultMain
diff --git a/demo/MidiDatatypes.hs b/demo/MidiDatatypes.hs
new file mode 100644
--- /dev/null
+++ b/demo/MidiDatatypes.hs
@@ -0,0 +1,252 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  MidiDatatypes
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  volatile
+-- Portability :  to be determined.
+--
+-- Syntax tree for MIDI files.
+--
+--------------------------------------------------------------------------------
+
+
+module MidiDatatypes (
+    -- * MidiFile representation
+    MidiFile(..),
+    -- * File header with basic information
+    Header(..),
+    -- * Track - a series of events
+    Track(..),
+    -- * Header format
+    HFormat(..),
+    
+    DeltaTime,
+
+    -- * A midi event paired with the delta time of its onset
+    Message, 
+    -- * A control or meta event
+    Event(..),
+    
+    VoiceEvent(..),
+    SystemEvent(..),
+    MetaEvent(..),
+    
+    -- * Representation of delta times as a division of quarter notes
+    TimeDivision(..),
+    -- * Type of a text meta-event
+    TextType(..),
+    
+    -- * Scale type - used for setting key signature
+    ScaleType(..),
+    
+    -- * Two helpers
+    varlenSplit, hexStr
+    
+  ) where
+
+import Data.Bits
+import Data.Int
+import Data.Sequence
+import Data.Word
+import Numeric (showHex)
+
+
+
+data MidiFile = MidiFile Header (Seq Track)
+  deriving (Eq,Show)
+
+-- | @'Header' fmt nt td@ 
+--
+-- @fmt@ - file format - see @'HFormat'@, 
+-- @nt@  - number of tracks,
+-- @td@  - @'TimeDivision'@, often 384 or 480 ticks per beat.
+-- The header is the start of a MIDI file, it is indicated by the 
+-- marker \'@MThd@\'.   
+data Header = Header HFormat Word16 TimeDivision
+  deriving (Eq,Show)
+
+-- | @'Track' xs@ 
+--
+-- @xs@ - list of @'Message'@. In MIDI files, the start of a track is
+-- indicated by the marker \'@MTrk@\'.  
+newtype Track = Track { getTrack :: Seq Message }
+  deriving (Eq,Show)
+
+-- | @'HFormat'@ 
+--
+-- The file format - in a MIDI file this is a big-endian word16 with 0,1 or 2
+-- being the only valid values. 
+data HFormat 
+    -- | Format 0 file - single multi-channel track.
+    = MF0 
+    -- | Format 1 file - 1 or more tracks, played simultaneously.
+    | MF1
+    -- | Format 2 file - 1 or more independent tracks.
+    | MF2
+  deriving (Eq, Enum, Show) 
+
+-- | @'TimeDivision'@ 
+--
+-- Defines the default unit of time in the MIDI file.
+data TimeDivision 
+    -- | frames per second.
+    = FPS Word16
+    -- | ticks per beat, i.e. the number of units for a quater note.
+    | TPB Word16    
+  deriving (Eq,Show)
+                                             
+-- | @'TextType'@ 
+--
+-- Signal the type of a text meta event.
+data TextType 
+    = GENERIC_TEXT 
+    | COPYRIGHT_NOTICE 
+    | SEQUENCE_NAME 
+    | INSTRUMENT_NAME
+    | LYRICS 
+    | MARKER 
+    | CUE_POINT 
+  deriving (Eq,Enum,Ord,Show) 
+
+-- | @'DeltaTime'@ 
+--
+-- All time values in a MIDI track are represented as a \delta\ from the 
+-- previous event rather than an absolute time. 
+-- Although DeltaTime is a type synonym for Word32, in MIDI files it is 
+-- represented as a @varlen@ to save space. 
+type DeltaTime = Word32
+
+-- | @'Message'@ 
+--
+-- MIDI messages are pairs of @'DeltaTime'@ and @'Event'@ wrapped in a newtype. 
+-- Sequential messages with delta time 0 will be played simultaneously.  
+type Message = (DeltaTime, Event)
+
+
+-- Note, the Ord instance for pairs is very useful for rendering.
+-- When we have have a NoteOn and a NoteOff on the same channel at the 
+-- same time we want the NoteOff played first. An ordinary sort will 
+-- give us this.
+
+     
+
+
+-- | @'Event'@ 
+--
+-- MIDI has three types of event.
+data Event 
+    -- | Meta events - usually interpretable (e.g. @end-of-track@, @set-tempo@).
+    = MetaEvent         MetaEvent
+    -- | SysEx - system exclusive - events. Usually synthesizer specific.
+    | SystemEvent       SystemEvent
+    -- | Voice events (e.g @note-on@, @note-off@) are relayed to specific
+    -- channels.
+    | VoiceEvent        VoiceEvent    
+  deriving (Eq,Show,Ord)
+
+-- | @'VoiceEvent'@ 
+--
+-- Voice events control the output of the synthesizer.
+-- Note - these are not in the the same order as there byte values
+-- Controller and ProgramChange are higher than they /naturally/
+-- occur so the will come first after a comparison / sort.
+data VoiceEvent 
+    -- | @Controller chan type value@ - controller change to the channel,
+    -- e.g. by a footswitch.
+    = Controller          Word8 Word8 Word8
+    -- | @ProgramChange chan num@ - change the instrument playing on the 
+    -- specified channel. See 'GMInst' for the instruments available with
+    -- General MIDI.
+    | ProgramChange       Word8 Word8
+    -- | @NoteOff chan note velocity@ - turn off a sounding note.
+    | NoteOff             Word8 Word8 Word8   
+    -- | @NoteOn chan note velocity@ - start playing a note.
+    | NoteOn              Word8 Word8 Word8
+    -- | @NoteAftertouch chan note value@ - change in pressure applied to 
+    -- the synthesizer key. 
+    | NoteAftertouch      Word8 Word8 Word8     
+    -- | @ChanAftertouch chan value@ - 
+    | ChanAftertouch      Word8 Word8
+    -- | @PitchBend chan value@ - change the pitch of a sounding note. 
+    -- Often used to approxiamate microtonal tunings.
+    | PitchBend           Word8 Word16
+  deriving (Eq,Show,Ord)
+
+-- | @'SystemEvent'@ 
+--
+-- \SysEx\ events - these are generally uninterpreted. 
+data SystemEvent 
+    -- | @SysEx length data@ - an uninterpreted sysex event.          
+    = SysEx               Word32 [Word8]
+    -- | @DataEvent value@ - value should be in the range 0..127.
+    | DataEvent           Word8 
+  deriving (Eq,Show,Ord)
+
+-- | @'MetaEvent'@ 
+--
+-- Meta events - in Format 1 files \general\ events (e.g. text events) should
+-- only appear in track 1. \Specific\ events (e.g. end-of-track) should appear
+-- in any track where necessary. 
+data MetaEvent
+    -- | @TextEvent text_type contents@ - a free text field (e.g. copyright).
+    -- The contents can notionally be any length.
+    = TextEvent           TextType String
+    -- | @SequenceNumber value@ - Format 1 files - only track 1 should have a 
+    -- sequence number. Format 2 files - a sequence number should identify 
+    -- each track. 
+    -- This should occur at the start of a track, before any non-zero time 
+    -- events.
+    | SequenceNumber      Word16
+    -- | @ChannelPrefix chan@ - relay all meta and sysex events to the 
+    -- given channel.
+    | ChannelPrefix       Word8
+    -- | @EndOfTrack@ - indicated end of track. 
+    | EndOfTrack
+    -- | @SetTempo mspqn@ - microseconds per quarter-note.
+    | SetTempo            Word32
+    -- | @SMPTEOffset hour  minute second frac subfrac@ - the SMPTE time when 
+    -- a track should start. This should occur at the start of a track,
+    -- before any non-zero time events.
+    | SMPTEOffset         Word8 Word8 Word8 Word8 Word8
+    
+    -- | @TimeSignature numerator denominator metro num-32nd-notes@ - time 
+    -- signature.
+    | TimeSignature       Word8 Word8 Word8 Word8
+    
+    -- | @KeySignature key_type scale_type@ - key_type is the number of 
+    -- sharps (postive numbers) or flats (negative numbers), 
+    -- e.g. (-1) is 1 flat.
+    -- 'ScaleType' indicates major or minor.  
+    | KeySignature        Int8 ScaleType
+    
+    -- | @SSME length data@ - sequencer specific meta-event.
+    | SSME                Word32 [Word8]
+  deriving (Eq,Show,Ord)
+
+-- | @'ScaleType'@ 
+--
+-- Scale type - @major@ or @minor@.  
+data ScaleType = MAJOR | MINOR
+  deriving (Eq,Enum,Ord,Show)
+
+--------------------------------------------------------------------------------
+-- helper for varlen
+--------------------------------------------------------------------------------
+-- | @varlenSplit@ - reduce a varlen into a list of Word8. 
+varlenSplit :: Word32 -> [Word8]
+varlenSplit i | i < 0x80        = [fromIntegral i]
+              | i < 0x4000      = [wise i 7, wise i 0]
+              | i < 0x200000    = [wise i 14, wise i 7, wise i 0] 
+              | otherwise       = [wise i 21, wise i 14, wise i 7, wise i 0] 
+  where         
+    wise m 0 = fromIntegral $ m .&. 0x7F
+    wise m n = fromIntegral $ m `shiftR` n   .&.  0x7F  .|.  0x80;
+    
+
+hexStr :: (Integral a) => a -> String
+hexStr i = (showString "0x" . showHex i) "" 
diff --git a/demo/MidiRead.hs b/demo/MidiRead.hs
new file mode 100644
--- /dev/null
+++ b/demo/MidiRead.hs
@@ -0,0 +1,233 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  MidiRead
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  volatile
+-- Portability :  to be determined.
+--
+-- A MIDI file parser. 
+--
+--------------------------------------------------------------------------------
+
+module MidiRead (
+    -- * Read a MIDI file
+    -- $readmididoc
+    readMidi
+  ) where
+
+import MidiDatatypes
+
+import Data.ParserCombinators.KangarooWriter
+
+import Control.Applicative
+import Control.Monad
+import Data.Bits
+import Data.Sequence ( Seq , (<|) )
+import qualified Data.Sequence as S
+import Data.Word
+
+type MidiParser a = Kangaroo String a
+
+
+readMidi :: FilePath -> IO MidiFile  
+readMidi filename = do 
+   (a,w) <- runKangaroo midiFile filename
+   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
+
+-}
+
+--------------------------------------------------------------------------------
+-- 
+
+
+    
+midiFile :: MidiParser MidiFile  
+midiFile = 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 
+
+countS :: Int -> MidiParser a -> MidiParser (Seq a)
+countS = genericCount (<|) S.empty 
+
+
+track :: MidiParser Track
+track = liftM Track (trackHeader >>= getMessages)
+
+trackHeader :: MidiParser Word32
+trackHeader = assertString "MTrk" >> word32be
+
+getMessages :: Word32 -> MidiParser (Seq Message)
+
+getMessages i = alfineRelative 0 (fromIntegral i) messages
+  where    
+    messages = genericRunOn (<|) S.empty message
+
+message :: MidiParser Message
+message = pairA deltaTime (uncurry next =<< word8split)
+  where  
+    next code chan  
+        | code == 0xF && chan == 0xF  = MetaEvent   <$> (word8 >>= metaEvent)         
+        | code == 0xF                 = SystemEvent <$> systemEvent
+        | code >= 0x8 && code <  0xF  = VoiceEvent  <$> voiceEvent code chan
+        | otherwise                   = reportError $ unwords 
+                                          [ "unrecognized message "
+                                          , hexStr ((code `shiftL` 4) + chan)
+                                          , "code:"
+                                          , hex2 code []
+                                          , "chan:"
+                                          , hex2 chan []
+                                          ]
+
+
+
+deltaTime :: MidiParser Word32
+deltaTime = getVarlen
+   
+voiceEvent :: Word8 -> Word8 -> MidiParser VoiceEvent
+voiceEvent 0x8 ch = (NoteOff ch)        <$> word8 <*> word8
+voiceEvent 0x9 ch = (NoteOn ch)         <$> word8 <*> word8
+voiceEvent 0xA ch = (NoteAftertouch ch) <$> word8 <*> word8
+voiceEvent 0xB ch = (Controller ch)     <$> word8 <*> word8
+voiceEvent 0xC ch = (ProgramChange ch)  <$> word8 
+voiceEvent 0xD ch = (ChanAftertouch ch) <$> word8 
+voiceEvent z   _  = reportError $ "voiceEvent " ++ hexStr z 
+
+
+
+
+metaEvent :: Word8 -> MidiParser MetaEvent
+metaEvent 0x00 = SequenceNumber   <$> (assertWord8 2     *> word16be)
+metaEvent 0x01 = textEvent GENERIC_TEXT 
+metaEvent 0x02 = textEvent COPYRIGHT_NOTICE
+metaEvent 0x03 = textEvent SEQUENCE_NAME
+metaEvent 0x04 = textEvent INSTRUMENT_NAME
+metaEvent 0x05 = textEvent LYRICS
+metaEvent 0x06 = textEvent MARKER
+metaEvent 0x07 = textEvent CUE_POINT
+metaEvent 0x2F = EndOfTrack       <$   assertWord8 0  
+metaEvent 0x51 = SetTempo         <$> (assertWord8 3     *> word24be)
+metaEvent 0x54 = SMPTEOffset      <$> (assertWord8 5     *> word8) 
+                                  <*> word8             <*> word8
+                                  <*> word8             <*> word8
+metaEvent 0x58 = TimeSignature    <$> (assertWord8 4     *> word8)
+                                  <*> word8             <*> word8 
+                                  <*> word8 
+metaEvent 0x59 = KeySignature     <$> (assertWord8 2     *> int8) 
+                                  <*> scale
+metaEvent 0x7F = (uncurry SSME)   <$> getVarlenBytes     
+metaEvent z    = reportError $ "unreconized meta-event " ++ hexStr z
+
+
+systemEvent :: MidiParser SystemEvent
+systemEvent = (uncurry SysEx) <$> getVarlenBytes
+                      
+                          
+format :: MidiParser HFormat
+format = word16be >>= fn 
+  where 
+    fn 0 = return MF0
+    fn 1 = return MF1
+    fn 2 = return MF2
+    fn z = reportError $ 
+              "getFormat - unrecognized file format " ++ hexStr z
+        
+timeDivision :: MidiParser TimeDivision
+timeDivision = division <$> word16be
+  where division i | i `testBit` 15 = FPS (i `clearBit` 15)
+                   | otherwise      = TPB i
+
+
+scale :: MidiParser ScaleType
+scale = word8 >>= fn 
+  where
+    fn 0 = return MAJOR
+    fn 1 = return MINOR
+    fn z = reportError $ "scale expecting 0 or 1, got " ++ hexStr z
+    
+    
+textEvent :: TextType -> MidiParser MetaEvent
+textEvent ty = (TextEvent ty . snd) <$> getVarlenText
+
+--------------------------------------------------------------------------------
+-- helpers
+
+{-
+-- enumerate doesn't really seem worth it for scale etc... 
+enumerate :: Integral a => [ans] -> a -> String -> MidiParser ans
+enumerate []     _ msg = reportError msg
+enumerate (x:xs) i msg | i == 0    = return x
+                       | otherwise = enumerate xs (i-1) msg
+
+-}
+
+
+word24be   :: MidiParser Word32
+word24be   = w32be 0 <$> word8 <*> word8 <*> word8
+
+
+word8split :: MidiParser (Word8,Word8) 
+word8split = split <$> word8 
+  where
+    split i = ((i .&. 0xF0) `shiftR` 4, i .&. 0x0F)
+
+ 
+assertWord8 :: Word8 -> MidiParser Word8
+assertWord8 i = postCheck word8 (==i) msg
+  where 
+    msg = "assertWord8 - input did not match " ++ show i
+             
+assertWord32 :: Integral a => a -> MidiParser Word32
+assertWord32 i = postCheck word32be ((==i) . fromIntegral) msg
+  where
+    msg = "assertWord32 - input did not match " ++ show i
+
+assertString :: String -> MidiParser String
+assertString s = postCheck (text $ length s) (==s) msg
+  where
+    msg = "assertString - input did not match " ++ s
+
+
+getVarlenText :: MidiParser (Word32,String)  
+getVarlenText = countPrefixed getVarlen char
+
+getVarlenBytes :: MidiParser (Word32,[Word8]) 
+getVarlenBytes = countPrefixed getVarlen word8
+
+
+getVarlen :: MidiParser Word32
+getVarlen = buildWhile (`testBit` 7) merge merge 0 word8
+  where
+    merge i acc = (acc `shiftL` 7) + ((fromIntegral i) .&. 0x7F)
+   
+
+
diff --git a/demo/MidiText.hs b/demo/MidiText.hs
new file mode 100644
--- /dev/null
+++ b/demo/MidiText.hs
@@ -0,0 +1,160 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  MidiText
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  volatile
+-- Portability :  to be determined.
+--
+-- Pretty print a textual representaton of MIDI files. 
+--
+--------------------------------------------------------------------------------
+
+
+module MidiText (
+    -- * Print a readable text representation
+    printMidi, ppMidiFile,
+    
+    ppHeader, ppMessage,
+  
+  ) where
+
+
+import MidiDatatypes
+
+import qualified Data.Foldable as F
+import Numeric
+import Text.PrettyPrint.HughesPJ
+
+
+printMidi :: MidiFile -> IO ()
+printMidi = putStrLn . render . ppMidiFile 
+
+
+
+
+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 []
+
+
+
+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
+  
+ppHFormat :: HFormat -> Doc
+ppHFormat MF0  = text "Type 0"
+ppHFormat MF1  = text "Type 1"
+ppHFormat MF2  = text "Type 2"
+ 
+ppTimeDivision :: TimeDivision -> Doc
+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)
+  where
+    fn (gt,doc) msg@(dt,_)  = 
+      (gt+dt, doc $$ (padshow 8 (gt+dt) `hyph` ppMessage msg))    
+
+
+ppMessage :: Message -> Doc
+ppMessage (dt,evt) = padshow 5 dt `hyph` ppEvent evt      
+
+
+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 
+                  
+
+
+fli :: (Integral a, Show a) => a -> Doc
+fli = padshow 3
+
+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
+
+  
+
+ppSystemEvent :: SystemEvent -> Doc
+ppSystemEvent (SysEx _ _)    = text "sysex"   -- system exclusive event - length x data
+ppSystemEvent (DataEvent i)  = text "data" <+> ppHex 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 "..."
+
+ppScaleType :: ScaleType -> Doc
+ppScaleType MAJOR  = text "major"
+ppScaleType MINOR  = text "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"
+  
diff --git a/demo/PrintMidi.hs b/demo/PrintMidi.hs
new file mode 100644
--- /dev/null
+++ b/demo/PrintMidi.hs
@@ -0,0 +1,38 @@
+{-# OPTIONS -Wall #-}
+
+
+-- shell> ghc --make PrintMIDI.hs 
+--
+-- shell> runhaskell.exe PrintMIDI.hs bulgarian6.mid
+
+
+
+module Main where
+
+import MidiRead
+import MidiText
+
+
+import Control.Exception
+import Prelude hiding (catch)
+
+import System.Environment
+import System.Exit
+
+
+main :: IO ()
+main = do 
+  args <- getArgs
+  case args of
+    [path] -> process path
+    _ ->  putStrLn "Usage: MidiPrint <filename>"
+
+process :: FilePath -> IO ()
+process filename = do
+    ans <- catch (readMidi filename) exitHandle
+    printMidi ans
+  where
+    exitHandle :: IOException -> IO a 
+    exitHandle e = putStrLn (show e) >> exitFailure
+
+ 
diff --git a/kangaroo.cabal b/kangaroo.cabal
new file mode 100644
--- /dev/null
+++ b/kangaroo.cabal
@@ -0,0 +1,72 @@
+name:             kangaroo
+version:          0.1.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.
+description:
+  Binary parsing with random access. The target file to be 
+  parsed is loaded into memory at the start (represented as
+  an IOUArray Int Word8). Parsing proceeds by moving a cursor
+  around, the array is left intact. This allows _jumping_
+  inside the file and contrasts with other parser 
+  combinators that progress via consuming input.
+  .
+  \* Caveat \* - the above of course means that the target file 
+  is obliged to be small enough to fit into memory. 
+  .
+  \*\* MAJOR CAVEAT \*\* - kangaroo is somewhat half-baked at the
+  moment - the parsing machinery seems good but the combinators
+  and primitive parsers need more work. I\'ve only released it on 
+  Hackage because I'm now using it with Hurdle which was already 
+  on Hackage.
+  .
+  Changelog:
+  . 
+  0.1.0 First version
+  
+build-type:         Simple
+stability:          half baked
+cabal-version:      >= 1.2
+
+extra-source-files:
+  demo/MidiDatatypes.hs
+  demo/MidiRead.hs
+  demo/MidiText.hs
+  demo/PrintMidi.hs
+  test/Picklers.hs
+
+
+library
+  hs-source-dirs:     src
+  build-depends:      base < 5,
+                      array >= 0.3.0.0 && < 0.4
+
+  
+  exposed-modules:
+    Data.ParserCombinators.Kangaroo,
+    Data.ParserCombinators.KangarooReader
+    Data.ParserCombinators.KangarooRWS,
+    Data.ParserCombinators.KangarooState,
+    Data.ParserCombinators.KangarooWriter,
+    Data.ParserCombinators.Kangaroo.Combinators,
+    Data.ParserCombinators.Kangaroo.IEEEFloat,
+    Data.ParserCombinators.Kangaroo.ParseMonad,
+    Data.ParserCombinators.Kangaroo.Prim,
+    Data.ParserCombinators.Kangaroo.Utils
+
+  other-modules:
+      
+  extensions:
+    
+
+  ghc-options:
+  
+  includes: 
+  
+
+  
+  
diff --git a/src/Data/ParserCombinators/Kangaroo.hs b/src/Data/ParserCombinators/Kangaroo.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo.hs
@@ -0,0 +1,43 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Binary parser combinators with random access
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo 
+  (
+    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.Prim
+import Data.ParserCombinators.Kangaroo.Utils hiding ( (<:>), oo, ooo, oooo )
+
+
+type Kangaroo a = GenKangaroo () a
+
+runKangaroo :: Kangaroo a -> FilePath -> IO (Either ParseErr a)
+runKangaroo p filename = runGenKangaroo p () filename >>= \(a,_) -> return a
+
+-- jsut runKangaroo here
+parse :: Kangaroo a -> FilePath -> IO (Either ParseErr a)
+parse = runKangaroo 
+
diff --git a/src/Data/ParserCombinators/Kangaroo/Combinators.hs b/src/Data/ParserCombinators/Kangaroo/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/Combinators.hs
@@ -0,0 +1,192 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.Combinators
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Combinators
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.Combinators 
+  ( 
+    satisfy
+  , manyTill
+  , genericManyTill
+  , manyTillPC
+  , genericManyTillPC
+  , count
+  , countPrefixed
+  , genericCount
+  , runOn
+  , genericRunOn
+  , postCheck
+  , buildWhile
+  , buildPrimitive
+
+  ) where
+
+import Data.ParserCombinators.Kangaroo.ParseMonad
+import Data.ParserCombinators.Kangaroo.Utils
+
+import Control.Applicative
+import Data.Word
+
+satisfy :: (Word8 -> Bool) -> GenKangaroo ust Word8
+satisfy p = word8 >>= \x -> 
+    if p x then return x else reportError $ "satisfy"
+
+
+manyTill :: GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust [a]
+manyTill = genericManyTill (:) [] 
+
+
+
+genericManyTill :: (a -> c -> c) -> c 
+                -> GenKangaroo ust a 
+                -> GenKangaroo ust b
+                -> GenKangaroo ust c
+genericManyTill op initial p end = opt end >>= \ans ->
+    case ans of 
+      Just _  -> return initial
+      Nothing -> op <$> p <*> genericManyTill op initial p end
+
+
+manyTillPC :: GenKangaroo ust a -> (a -> Bool) -> GenKangaroo ust ([a],a)
+manyTillPC = genericManyTillPC (:) []
+
+genericManyTillPC :: (a -> b -> b) -> b 
+                  -> GenKangaroo ust a 
+                  -> (a -> Bool) 
+                  -> GenKangaroo ust (b,a)
+genericManyTillPC op initial p check =  p >>= \ans ->
+  if check ans then do { (acc,end) <- genericManyTillPC op initial p check
+                       ; return (ans `op` acc,end)
+                       }
+               else return (initial,ans) 
+   
+count :: Int -> GenKangaroo ust a -> GenKangaroo ust [a]
+count = genericCount (:) []
+
+
+-- Generalized version of count (like a fold)
+genericCount :: (a -> b -> b) -> b -> Int 
+             -> GenKangaroo ust a 
+             -> GenKangaroo ust b
+genericCount op initial i p 
+    | i <= 0    = pure initial
+    | otherwise = op <$> p <*> genericCount op initial (i-1) p
+
+countPrefixed :: Integral i 
+              => GenKangaroo ust i -> GenKangaroo ust a -> GenKangaroo ust (i,[a]) 
+countPrefixed plen p = plen >>= \i -> 
+    count (fromIntegral i) p >>= \ans -> return (i,ans)
+
+
+runOn :: GenKangaroo ust a -> GenKangaroo ust [a]
+runOn p = atEnd >>= \end -> if end then return [] else p <:> runOn p
+
+
+genericRunOn :: (a -> b -> b) -> b -> GenKangaroo ust a -> GenKangaroo ust b
+genericRunOn op initial p = atEnd >>= \end -> 
+   if end then return initial else op <$> p <*> genericRunOn op initial p
+
+
+
+-- | Apply parse then apply the check, if the check fails report
+-- the error message. 
+postCheck :: GenKangaroo ust a -> (a -> Bool) -> String -> GenKangaroo ust a
+postCheck p check msg = p >>= \ans -> 
+    if check ans then return ans else reportError msg
+
+
+-- | Build a value by while the test holds. When the test fails 
+-- the position is not backtracked, instead we use the \"failing\"
+-- element with @lastOp@ potentially still building the value 
+-- with it.
+-- 
+buildWhile :: (a -> Bool) 
+           -> (a -> b -> b) 
+           -> (a -> b -> b) 
+           -> b 
+           -> GenKangaroo ust a 
+           -> GenKangaroo ust b
+buildWhile test op lastOp initial p = step where
+    step = p >>= \ans -> 
+      if test ans then (step >>= \acc -> return $ ans `op` acc)
+                  else (return $ ans `lastOp` initial)
+
+-- building on Word8\'s, progress is checked - only elements that 
+-- match the check are consumed up the the max count.
+buildPrimitive :: Int 
+               -> (Word8 -> Bool) 
+               -> (Word8 -> b -> b) 
+               -> b 
+               -> GenKangaroo ust b
+buildPrimitive maxc check op initial | maxc <= 0 = return initial
+                                     | otherwise = step 0 initial
+  where
+    step i a | i >= maxc = return a
+             | otherwise = checkWord8 check >>= \ans -> case ans of 
+                             Nothing -> return a 
+                             Just x  -> step (i+1) (x `op` a)
+
+ 
+
+-- Can't rely on Alternative as Kangaroo doesn't support it.
+{-
+
+choice :: Alternative f => [f a] -> f a
+choice = foldr (<|>) empty 
+          
+between :: Applicative f => f open -> f close -> f a -> f a
+between o c a = o *> a <* c
+
+          
+option :: Alternative f => a -> f a -> f a
+option x p          = p <|> pure x
+
+optionMaybe :: Alternative f => f a -> f (Maybe a)
+optionMaybe = optional
+
+-- aka Parsecs /optional/
+optionUnit :: Alternative f => f a -> f ()
+optionUnit p = () <$ p <|> pure ()
+
+skipMany1 :: Alternative f => f a -> f ()
+skipMany1 p = p *> skipMany p
+
+skipMany :: Alternative f => f a -> f ()
+skipMany p = many_p
+  where many_p = some_p <|> pure ()
+        some_p = p       *> many_p
+
+-- | @many1@ an alias for @some@. 
+many1 :: Alternative f => f a -> f [a]
+many1 = some
+
+sepBy :: Alternative f => f a -> f b -> f [a]
+sepBy p sep = sepBy1 p sep <|> pure []
+
+sepBy1 :: Alternative f => f a -> f b -> f [a]
+sepBy1 p sep = p <:> step where
+    step = (sep *> p) <:> step <|> pure []
+
+sepEndBy :: Alternative f => f a -> f b -> f [a]
+sepEndBy p sep = sepEndBy1 p sep <|> pure []
+
+sepEndBy1 :: Alternative f => f a -> f b -> f [a]
+sepEndBy1 p sep = (p <* sep) <:> step where
+    step = (p <* sep) <:> step <|> pure []
+    
+manyTill :: Alternative f => f a -> f b -> f [a]
+manyTill p end = step <|> pure [] where
+    step = p <:> (step <|> (pure [] <$> end))
+
+-}
diff --git a/src/Data/ParserCombinators/Kangaroo/IEEEFloat.hs b/src/Data/ParserCombinators/Kangaroo/IEEEFloat.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/IEEEFloat.hs
@@ -0,0 +1,118 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.IEEEFloat
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- IEEE floats (single precision so far...)
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.IEEEFloat where
+
+import Data.ParserCombinators.Kangaroo.Utils
+
+
+import Data.Bits
+import Data.Char
+import Data.Word
+import Numeric
+
+
+const_B :: Int
+const_B = 127
+
+
+printBin :: (Fractional a,Ord a) => a -> ShowS
+printBin a = 
+    f s . showChar ' ' . f t . showChar ' ' . f u . showChar ' ' . f v
+  where
+    f = showIntAtBase 2 (chr . (48+))
+    (s,t,u,v) = packIEEESingle a 
+  
+toAndFro :: (Fractional a, Ord a) => a -> a
+toAndFro a = let (s,t,u,v) = packIEEESingle a in unpackIEEESingle s t u v
+
+unpackIEEESingle :: Fractional a => Word8 -> Word8 -> Word8 -> Word8 -> a
+unpackIEEESingle b24_31 b16_23 b8_15 b0_7 =  sign $ fract * (2 ^^ expo)
+  where
+    sign  = if b24_31 `testBit` 7 then negate else id
+  
+    expo  = exponent' b24_31 b16_23
+  
+    fract = fraction b16_23 b8_15 b0_7
+
+
+exponent' :: Word8  -> Word8 -> Int
+exponent' a b = (a' `shiftL` 1) + (b' `shiftR` 7) - 127
+  where
+    a' = fromIntegral $ (a .&. 0x7f) 
+    b' = fromIntegral $ (b .&. 0x80)
+
+
+iPow :: Fractional a => a -> Integer -> a
+iPow = (^^)
+
+fraction :: Fractional a => Word8 -> Word8 -> Word8 -> a
+fraction b16_24 b8_15 b0_7 = 1.0 + ((fromIntegral frac) / (2 `iPow` 23))
+  where
+   frac :: Int 
+   frac = (shiftL16 (b16_24 .&. 0x7f)) + (shiftL8 b8_15) + fromIntegral b0_7
+    
+
+
+packIEEESingle :: (Fractional a,Ord a) => a -> (Word8,Word8,Word8,Word8)
+packIEEESingle a = (flipSign b24_31, exp_part+mant_part, b8_15, b0_7)
+  where
+    k     = findPosExpo $ abs a
+    e     = k + const_B
+    halfa = (abs a) / (2 `iPow` fromIntegral k)
+    f     = expand $ halfa - 1
+    
+    (b24_31, exp_part)          = expoWords e
+    (mant_part,b8_15, b0_7)     = mantWords f
+    
+    flipSign = if a > 0 then id else (`setBit` 7)
+
+
+findPosExpo :: (Fractional a, Ord a) => a -> Int
+findPosExpo r | r <= 0    = 0 
+              | otherwise = step r 1
+  where
+    step r' k | r <= fromIntegral (2::Int) ^^ k = k-1
+              | otherwise                       = step r' (k+1)
+
+
+expand :: (Fractional a, Ord a) => a -> Word32
+expand n = (`shiftR` 9) $ step n 0 id
+  where
+    step x ix f | x <= 0    = f (0::Word32) 
+                | otherwise = let y = 1 / (2 ^^ (ix+1))
+                              in if x >= y 
+                                 then step (x-y) (ix+1) (f . (`setBit` (31-ix)))
+                                 else step x (ix+1) f
+
+
+
+-- 7 bits left, 1 bit right
+expoWords :: Int -> (Word8,Word8)
+expoWords n = (left, right)
+  where
+    right = if n `testBit` 0 then 128 else 0
+    left  = fromIntegral $ n `shiftR` 1
+
+
+mantWords :: Word32 -> (Word8,Word8,Word8)
+mantWords x = (a,b,c)
+  where
+    c = fromIntegral $ x .&. 0xff
+    b = fromIntegral $ (`shiftR` 8)  $ x .&. 0xff00
+    a = fromIntegral $ (`shiftR` 16) $ x .&. 0xff0000
+    
+
diff --git a/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs b/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/ParseMonad.hs
@@ -0,0 +1,418 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.ParseMonad
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Random access parse monad 
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.ParseMonad 
+  (
+    GenKangaroo
+  , ParseErr
+  
+  , getSt
+  , putSt
+  , modifySt
+  
+  , getUserSt
+  , putUserSt
+  , modifyUserSt
+
+  , askEnv
+  , throwErr
+  , runGenKangaroo
+
+  , reportError
+  , substError
+  , word8
+  , checkWord8
+  , opt 
+  , position
+  , regionEnd
+  , atEnd
+  , lengthRemaining
+
+  -- * Parse within a /region/.
+  , dalpunto
+  , dalpuntoRelative
+  , advanceDalpunto
+  , advanceDalpuntoAbsolute
+
+  , alfine
+  , alfineRelative
+  , restrictAlfine
+
+  , alfermata
+  , alfermataRelative
+  , advanceAlfermata
+  , advanceAlfermataAbsolute
+  , restrictAlfermata 
+   
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Array.IO
+import Data.Word
+import Numeric
+import System.IO
+
+type ParseErr = String
+
+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
+  
+
+-- 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).
+--
+newtype GenKangaroo ust a = GenKangaroo { 
+          getGenKangaroo :: Env -> St -> ust -> IO (Either ParseErr a, St, ust) }
+          
+
+fmapKang :: (a -> b) -> GenKangaroo ust a -> GenKangaroo ust b
+fmapKang f (GenKangaroo x) = GenKangaroo $ \env st ust -> 
+    x env st ust `bindIO` \(a,st',ust') -> return (fmap f a, st', ust')
+
+
+instance Functor (GenKangaroo ust) where
+    fmap = fmapKang
+
+
+
+returnIO :: a -> IO a
+returnIO = return
+
+infixl 1 `bindIO`
+
+bindIO :: IO a -> (a -> IO b) -> IO b
+bindIO = (>>=)
+
+
+returnKang :: a -> GenKangaroo st a
+returnKang a = GenKangaroo $ \_ st ust -> returnIO (Right a, st, ust)
+
+infixl 1 `bindKang`
+
+bindKang :: GenKangaroo ust a -> (a -> GenKangaroo ust b) -> GenKangaroo ust b
+(GenKangaroo x) `bindKang` f = GenKangaroo $ \env st ust -> 
+    x env st ust `bindIO` \(ans, st', ust') ->
+        case ans of Left err -> returnIO (Left err,st',ust')
+                    Right a  -> getGenKangaroo (f a) env st' ust'
+ 
+
+
+
+instance Monad (GenKangaroo ust) where
+  return = returnKang
+  (>>=)  = bindKang
+
+
+instance Applicative (GenKangaroo ust) where
+  pure = return
+  (<*>) = ap
+
+-- I don't think Kangaroo has natural implementations of 
+-- Alternative or MonadPlus.
+-- My 'proposition' is that the sort of parsing that Kangaroo 
+-- intends to provide you always now want you want hence there 
+-- 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)
+
+
+getUserSt :: GenKangaroo ust ust
+getUserSt = GenKangaroo $ \_ st ust -> return (Right ust, st, ust)
+
+putUserSt :: ust -> GenKangaroo ust ()
+putUserSt ust = GenKangaroo $ \_ st _ -> return (Right (), st, ust)
+
+modifyUserSt :: (ust -> ust) -> GenKangaroo ust ()
+modifyUserSt f = GenKangaroo $ \_ st ust -> return (Right (), st, f ust)
+
+
+
+askEnv :: GenKangaroo ust Env
+askEnv = GenKangaroo $ \env st ust -> return (Right env, 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) 
+
+
+
+
+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
+
+
+
+--------------------------------------------------------------------------------
+-- 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
+    throwErr $ s ++ posStr posn
+  where
+    posStr (ArrIx pos end) = concat [ " absolute position "
+                                    , show pos
+                                    , " (0x" 
+                                    , showHex pos []
+                                    , "), region length "
+                                    , show end
+                                    ]
+
+
+substError :: GenKangaroo ust a -> ParseErr -> GenKangaroo ust a
+substError p msg = GenKangaroo $ \env st ust -> 
+    (getGenKangaroo p) env st ust >>= \ ans -> 
+      case ans of
+        (Left _, st', ust')  -> return (Left msg, st', ust')
+        okay                 -> return okay
+
+   
+word8 :: GenKangaroo ust Word8
+word8 = do
+    (ArrIx ix end)   <- getSt
+    when (ix>end)    (reportError "word8")   -- test emphatically is (>) !
+    arr              <- askEnv
+    a                <- liftIOAction $ readArray arr ix
+    putSt $ ArrIx (ix+1) end
+    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
+
+
+
+-- no 'try' in Kangaroo... 
+-- opt is the nearest to it, opt backtracks the cursor onm 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/ ...
+
+-- 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.
+--
+-- 3. alfermata - 'to the stop'    
+-- - Run the parser within a region, the cursor remains wherever 
+--   the parse finished.
+--
+
+
+
+
+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 ()
+
+
+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
+    ]
+
+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
+    ]
+
+
+-- Parser inside the supplied region, afterwards restore the
+-- end of the /outer/ region and return to the initial position.
+--
+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
+    
+
+
+-- | return to the start position - start x length
+dalpunto :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
+dalpunto = dalpuntoP "dalpunto"
+
+
+-- | 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
+
+
+-- Parse inside the supplied region, afterwards go to the end of
+-- the supplied region and restore the end of the /outer/ 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
+
+
+-- | alfine - parse to the end
+alfine :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
+alfine = alfineP "alfine"
+
+-- | 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
+
+
+restrictAlfine :: Int -> GenKangaroo ust p -> GenKangaroo ust p
+restrictAlfine dist_to_end p = getSt >>= \(ArrIx pos _) -> 
+    alfineP "restrictAlfine" pos (pos + dist_to_end) p
+    
+
+
+-- Parser inside the supplied region, afterwards restore the end 
+-- of the /outer/region but keep the cursor in at the current 
+-- position.
+--
+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.
+--
+alfermata :: Int -> Int -> GenKangaroo ust a -> GenKangaroo ust a
+alfermata = alfermataP "alfermata"
+
+
+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
+
+
+-- | 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
+
+-- | 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
+
+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/Prim.hs b/src/Data/ParserCombinators/Kangaroo/Prim.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/Prim.hs
@@ -0,0 +1,113 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.Prim
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Primitive parsers - charactors, numbers...
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.Prim 
+  (
+    cstring
+  , w8Zero
+  , getBytes
+  , char
+  , text
+  , int8
+  , word16be
+  , word32be
+  , word64be  
+  , word16le
+  , word32le
+  , int16be
+  , int32be
+  , int16le
+  , int32le
+
+  , ieeeFloatSP
+
+  ) where
+
+import Data.ParserCombinators.Kangaroo.Combinators
+import Data.ParserCombinators.Kangaroo.IEEEFloat
+import Data.ParserCombinators.Kangaroo.ParseMonad
+import Data.ParserCombinators.Kangaroo.Utils
+
+import Control.Applicative
+import Data.Char
+import Data.Int
+import Data.Word
+
+
+-- | Read a null-terminated string
+cstring :: GenKangaroo ust String
+cstring = manyTill char w8Zero
+
+
+w8Zero :: GenKangaroo ust Word8
+w8Zero = satisfy (==0)
+
+getBytes :: Integral a => a -> GenKangaroo ust [Word8]
+getBytes i = count (fromIntegral i) word8
+
+char :: GenKangaroo ust Char
+char = (chr . fromIntegral) <$> word8 
+
+
+
+text :: Int -> GenKangaroo ust String
+text = count `flip` char
+
+
+
+int8 :: GenKangaroo ust Int8
+int8 = (fromIntegral . unwrap) <$> word8
+  where
+    unwrap :: Word8 -> Int
+    unwrap i | i > 128   = (fromIntegral i) - 256
+             | otherwise = fromIntegral i
+
+word16be   :: GenKangaroo ust Word16
+word16be   = w16be     <$> word8 <*> word8  
+
+word32be   :: GenKangaroo ust Word32
+word32be   = w32be     <$> word8 <*> word8 <*> word8 <*> word8
+
+word64be   :: GenKangaroo ust Word64
+word64be   = w64be <$> word8 <*> word8 <*> word8 <*> word8
+                   <*> word8 <*> word8 <*> word8 <*> word8
+
+word16le   :: GenKangaroo ust Word16
+word16le   = w16le     <$> word8 <*> word8  
+
+word32le   :: GenKangaroo ust Word32
+word32le   = w32le     <$> word8 <*> word8 <*> word8 <*> word8
+
+
+int16be   :: GenKangaroo ust Int16
+int16be   = i16be <$> word8 <*> word8
+  
+int32be   :: GenKangaroo ust Int32
+int32be   = i32be <$> word8 <*> word8 <*> word8 <*> word8
+
+                         
+int16le   :: GenKangaroo ust Int16
+int16le   = i16le <$> word8 <*> word8
+                         
+int32le   :: GenKangaroo ust Int32
+int32le   = i32le <$> word8 <*> word8 <*> word8 <*> word8
+
+
+ieeeFloatSP :: Fractional a => GenKangaroo ust a
+ieeeFloatSP = unpackIEEESingle <$> word8 <*> word8 <*> word8 <*> word8
+
+
+
diff --git a/src/Data/ParserCombinators/Kangaroo/Utils.hs b/src/Data/ParserCombinators/Kangaroo/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/Kangaroo/Utils.hs
@@ -0,0 +1,195 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.Kangaroo.Utils
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Utils...
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.Kangaroo.Utils 
+  ( 
+    (<:>)
+  , pairA
+  , mprogress
+
+  -- * Specs
+  , oo
+  , ooo
+  , oooo
+
+  -- * numbers from Word8 
+  , w16be
+  , w32be
+
+  , w16le
+  , w32le
+  , w64be
+
+  , i16be
+  , i32be
+
+  , i16le
+  , i32le
+  
+  , shiftL8
+  , shiftL16
+  , shiftL24
+  , shiftL32
+  , shiftL40
+  , shiftL48
+  , shiftL56
+  
+  -- * Hex printing
+  , hex2
+  , hex4
+  , hex8
+  
+
+  ) where
+
+
+import Control.Applicative
+
+import Data.Bits
+import Data.Int
+import Data.Word
+import Numeric
+
+infixr 5 <:>
+
+-- | applicative cons
+(<:>) :: Applicative f => f a -> f [a] -> f [a]
+(<:>) p1 p2 = (:) <$> p1 <*> p2
+
+
+    
+
+pairA :: Applicative f => f a -> f b -> f (a,b)
+pairA fa fb = (,) <$> fa <*> fb
+
+-- 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
+
+-- specs - defined in my package data-aviary but defined here to 
+-- avoid a dependency
+
+-- | Compose an arity 1 function with an arity 2 function.
+-- B1 - blackbird
+oo :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+oo f g = (f .) . g
+
+-- | Compose an arity 1 function with an arity 3 function.
+-- B2 - bunting
+ooo :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
+ooo f g = ((f .) .) . g
+
+-- | Compose an arity 1 function with an arity 4 function.
+oooo :: (e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f
+oooo f g = (((f .) .) .) . g  
+
+
+
+--------------------------------------------------------------------------------
+
+
+
+w16le :: Word8 -> Word8 -> Word16
+w16le a b = fromIntegral a + (shiftL8 b)
+
+w32le :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
+w32le a b c d = fromIntegral a + (shiftL8 b) + (shiftL16 c) + (shiftL24 d)      
+
+
+-- Woah! The integer ones don't look right - what about the sign?
+
+i16le :: Word8 -> Word8 -> Int16
+i16le a b = fromIntegral $ w16le a b
+              
+i32le :: Word8 -> Word8 -> Word8 -> Word8 -> Int32
+i32le a b c d  = fromIntegral $ w32le a b c d                
+
+
+i16be :: Word8 -> Word8 -> Int16
+i16be a b = fromIntegral $ w16be a b
+                            
+i32be :: Word8 -> Word8 -> Word8 -> Word8 -> Int32
+i32be a b c d = fromIntegral $ w32be a b c d
+
+
+w16be :: Word8 -> Word8 -> Word16
+w16be a b = (shiftL8 a) + fromIntegral b
+     
+            
+w32be :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
+w32be a b c d = (shiftL24 a) + (shiftL16 b) + (shiftL8 c) + fromIntegral d
+
+-- To do...
+w64be :: Word8 -> Word8 -> Word8 -> Word8 -> 
+           Word8 -> Word8 -> Word8 -> Word8 -> Word64
+w64be a b c d e f g h = a' + b' + c' + d' + e' + f' + g' + h' where
+    a' = (fromIntegral a) `shiftL` 56
+    b' = (fromIntegral b) `shiftL` 48
+    c' = (fromIntegral c) `shiftL` 40
+    d' = (fromIntegral d) `shiftL` 32
+    e' = (fromIntegral e) `shiftL` 24
+    f' = (fromIntegral f) `shiftL` 16
+    g' = (fromIntegral g) `shiftL` 8
+    h' = (fromIntegral h) 
+
+
+shiftL8 :: (Bits b, Integral b) => Word8 -> b
+shiftL8 = (`shiftL` 8) . fromIntegral
+
+shiftL16 :: (Bits b, Integral b) => Word8 -> b
+shiftL16 = (`shiftL` 16) . fromIntegral
+
+shiftL24 :: (Bits b, Integral b) => Word8 -> b
+shiftL24 = (`shiftL` 24) . fromIntegral
+
+shiftL32 :: (Bits b, Integral b) => Word8 -> b
+shiftL32 = (`shiftL` 32) . fromIntegral
+
+shiftL40 :: (Bits b, Integral b) => Word8 -> b
+shiftL40 = (`shiftL` 40) . fromIntegral
+
+shiftL48 :: (Bits b, Integral b) => Word8 -> b
+shiftL48 = (`shiftL` 48) . fromIntegral
+
+shiftL56 :: (Bits b, Integral b) => Word8 -> b
+shiftL56 = (`shiftL` 56) . fromIntegral
+
+
+
+
+hex2 :: Integral a => a -> ShowS
+hex2 a | a < 0      = showString "-ve"
+       | a < 0x10   = showString "0x0" . showHex a
+       | otherwise  = showString "0x"  . showHex a 
+
+
+hex4 :: Integral a => a -> ShowS
+hex4 a | a < 0      = showString "-ve"
+       | a < 0x10   = showString "0x000" . showHex a
+       | a < 0x100  = showString "0x00"  . showHex a 
+       | a < 0x1000 = showString "0x0"   . showHex a 
+       | otherwise  = showString "0x"    . showHex a 
+
+hex8 :: Integral a => a -> ShowS
+hex8 a | a < 0          = showString "-ve"
+       | a < 0x10       = showString "0x0000000" . showHex a
+       | a < 0x100      = showString "0x000000"  . showHex a 
+       | a < 0x1000     = showString "0x00000"   . showHex a 
+       | a < 0x10000    = showString "0x0000"    . showHex a 
+       | a < 0x100000   = showString "0x000"     . showHex a 
+       | a < 0x1000000  = showString "0x00"      . showHex a 
+       | a < 0x10000000 = showString "0x0"       . showHex a 
+       | otherwise      = showString "0x"        . showHex a 
diff --git a/src/Data/ParserCombinators/KangarooRWS.hs b/src/Data/ParserCombinators/KangarooRWS.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/KangarooRWS.hs
@@ -0,0 +1,112 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.KangarooRWS
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Kangaroo parse monad with user env, logging and state.
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.KangarooRWS
+  (
+    module Data.ParserCombinators.Kangaroo.Combinators
+  , module Data.ParserCombinators.Kangaroo.ParseMonad
+  , module Data.ParserCombinators.Kangaroo.Prim
+  , module Data.ParserCombinators.Kangaroo.Utils
+  , Kangaroo
+  , parse
+  , runKangaroo
+  , evalKangaroo
+  , execKangaroo
+  , put
+  , get
+  , modify
+  , gets
+  , tell
+  , ask
+
+  ) where
+
+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 Control.Monad
+import Data.Monoid
+
+type Kangaroo r w st a = GenKangaroo (r,w,st) a
+
+
+values :: (a,(r,w,st)) -> (a,w,st)
+values (ans,(_,w,ust)) = (ans,w,ust)
+
+
+state3 :: (r,w,st) -> st
+state3 (_,_,st) = st
+
+env3 :: (r,w,st) -> r
+env3 (r,_,_) = r
+
+parse :: Monoid w 
+      => Kangaroo r w st a 
+      -> r 
+      -> st 
+      -> FilePath 
+      -> IO (Either ParseErr a)
+parse = liftM fst `Specs.oooo` evalKangaroo 
+
+runKangaroo :: Monoid w 
+            => Kangaroo r w st a 
+            -> r 
+            -> st 
+            -> FilePath 
+            -> IO (Either ParseErr a,w,st)
+runKangaroo p env st filename = 
+    liftM values $ runGenKangaroo p (env,mempty,st) filename
+
+-- answer, no state
+evalKangaroo :: Monoid w 
+             => Kangaroo r w st a 
+             -> r 
+             -> st 
+             -> FilePath 
+             -> IO (Either ParseErr a,w)
+evalKangaroo = liftM fn `Specs.oooo` runKangaroo where
+    fn (a,w,_) = (a,w)
+
+-- state, no answer
+execKangaroo :: Monoid w 
+             => Kangaroo r w st a 
+             -> r 
+             -> st 
+             -> FilePath 
+             -> IO st
+execKangaroo = liftM state3 `Specs.oooo` runKangaroo 
+ 
+
+put :: st -> Kangaroo r w st ()
+put st = getUserSt >>= \(r,w,_) -> putUserSt (r,w,st)
+
+get :: Kangaroo r w st st
+get = liftM state3 getUserSt 
+
+modify :: (st -> st) -> Kangaroo r w st ()
+modify f = getUserSt >>= \(r,w,st) -> putUserSt (r,w,f st)
+
+gets :: (st -> a) -> Kangaroo r w st a
+gets f = liftM f get
+
+tell :: Monoid w => w -> Kangaroo r w st ()
+tell s = getUserSt >>= \(r,w,st) -> putUserSt (r,w `mappend` s,st)
+
+ask :: Kangaroo r w st r
+ask = liftM env3 getUserSt
diff --git a/src/Data/ParserCombinators/KangarooReader.hs b/src/Data/ParserCombinators/KangarooReader.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/KangarooReader.hs
@@ -0,0 +1,53 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.KangarooReader
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Kangaroo parse monad with env.
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.KangarooReader
+  (
+    module Data.ParserCombinators.Kangaroo.Combinators
+  , module Data.ParserCombinators.Kangaroo.ParseMonad
+  , module Data.ParserCombinators.Kangaroo.Prim
+  , module Data.ParserCombinators.Kangaroo.Utils
+  , Kangaroo
+  , parse
+  , runKangaroo
+  , ask
+
+  ) where
+
+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 Control.Monad ( liftM )
+
+type Kangaroo e a = GenKangaroo e a
+
+
+parse :: Kangaroo e a  
+      -> e
+      -> FilePath 
+      -> IO (Either ParseErr a)
+parse = runKangaroo 
+
+runKangaroo :: Kangaroo e a
+            -> e
+            -> FilePath 
+            -> IO (Either ParseErr a)
+runKangaroo p env filename = liftM fst (runGenKangaroo p env filename)
+
+ask :: Kangaroo e e
+ask = getUserSt
diff --git a/src/Data/ParserCombinators/KangarooState.hs b/src/Data/ParserCombinators/KangarooState.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/KangarooState.hs
@@ -0,0 +1,70 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.KangarooState
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Kangaroo parse monad with user state.
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.KangarooState
+  (
+    module Data.ParserCombinators.Kangaroo.Combinators
+  , module Data.ParserCombinators.Kangaroo.ParseMonad
+  , module Data.ParserCombinators.Kangaroo.Prim
+  , module Data.ParserCombinators.Kangaroo.Utils
+  , Kangaroo
+  , parse
+  , runKangaroo
+  , evalKangaroo
+  , execKangaroo
+  , put
+  , get
+  , modify
+  , gets
+
+  ) where
+
+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 Control.Monad
+
+type Kangaroo st a = GenKangaroo st a
+
+parse :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a)
+parse = evalKangaroo
+
+runKangaroo :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a,st)
+runKangaroo p st filename = runGenKangaroo p st filename
+
+-- answer, no state
+evalKangaroo :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a)
+evalKangaroo = liftM fst `Specs.ooo` runKangaroo
+
+-- state, no answer
+execKangaroo :: Kangaroo st a -> st -> FilePath -> IO st
+execKangaroo = liftM snd `Specs.ooo` runKangaroo
+
+
+put :: st -> Kangaroo st ()
+put = putUserSt
+
+get :: Kangaroo st st
+get = getUserSt
+
+modify :: (st -> st) -> Kangaroo st ()
+modify = modifyUserSt
+
+gets :: (st -> a) -> Kangaroo st a
+gets f = liftM f get
diff --git a/src/Data/ParserCombinators/KangarooWriter.hs b/src/Data/ParserCombinators/KangarooWriter.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ParserCombinators/KangarooWriter.hs
@@ -0,0 +1,53 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.ParserCombinators.KangarooWriter
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Kangaroo parse monad with logging.
+--
+--------------------------------------------------------------------------------
+
+module Data.ParserCombinators.KangarooWriter
+  (
+    module Data.ParserCombinators.Kangaroo.Combinators
+  , module Data.ParserCombinators.Kangaroo.ParseMonad
+  , module Data.ParserCombinators.Kangaroo.Prim
+  , module Data.ParserCombinators.Kangaroo.Utils
+  , Kangaroo
+  , parse
+  , runKangaroo
+  , tell
+
+  ) where
+
+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
+
+type Kangaroo r a = GenKangaroo r a
+
+
+parse :: Monoid w 
+      => Kangaroo w a  
+      -> FilePath 
+      -> IO (Either ParseErr a,w)
+parse = runKangaroo 
+
+runKangaroo :: Monoid w 
+            => Kangaroo w a
+            -> FilePath 
+            -> IO (Either ParseErr a,w)
+runKangaroo p filename = runGenKangaroo p mempty filename
+
+tell :: Monoid w => w -> Kangaroo w ()
+tell s = getUserSt >>= \w -> putUserSt $ w `mappend` s
diff --git a/test/Picklers.hs b/test/Picklers.hs
new file mode 100644
--- /dev/null
+++ b/test/Picklers.hs
@@ -0,0 +1,50 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Picklers
+-- Copyright   :  (c) Stephen Tetley 2009
+-- License     :  BSD3
+--
+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
+-- Stability   :  highly unstable
+-- Portability :  to be determined.
+--
+-- Pickling
+--
+--------------------------------------------------------------------------------
+
+module Picklers where
+
+
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+import Data.List ( foldl' )
+import Data.Word
+import System.IO
+
+newtype RevBS = RevBS { getRevBS :: BS.ByteString }
+
+type Pickle = RevBS
+
+empty :: RevBS 
+empty = RevBS BS.empty
+
+
+writePickle :: FilePath -> Pickle -> IO ()
+writePickle file pkl = withBinaryFile file WriteMode (BS.hPut `flip` rpkl)
+  where rpkl = BS.reverse $ getRevBS pkl 
+
+
+cons :: Char -> Pickle -> Pickle
+cons c = RevBS . BS.cons c . getRevBS 
+
+putCString :: String -> Pickle -> Pickle
+putCString s pkl = putWord8 0 $ foldl' (flip cons) pkl s
+
+putWord8 :: Word8 -> Pickle -> Pickle
+putWord8 w = cons (chr $ fromIntegral w)
+
+-- TODO 
+cstring :: String -> Pickle
+cstring = putCString `flip` empty