content: {-# LANGUAGE RankNTypes, TypeFamilies, PackageImports #-}
  module Text.Papillon.Papillon (
  	ParseError,
  	mkParseError,
  	peCode,
  	peMessage,
  	peComment,
  	peDerivs,
  	peReading,
  	pePosition,
  	pePositionS,
  	Pos(..),
  	Source(..),
  	SourceList(..),
  	ListPos(..),
  	runError) where
  import Control.Monad.Trans.Error (Error(..))
  import "monads-tf" Control.Monad.Error
  import "monads-tf" Control.Monad.Identity
  
  import qualified Data.ByteString.Char8 as BSC
  
  data ParseError pos drv
      = ParseError {peCode :: String,
                    peMessage :: String,
                    peComment :: String,
                    peDerivs :: drv,
                    peReading :: ([String]),
                    pePosition :: pos}
  instance Error (ParseError pos drv)
      where strMsg msg = ParseError "" msg "" undefined undefined undefined
  mkParseError :: forall pos drv . String ->
                                   String -> String -> drv -> [String] -> pos -> ParseError pos drv
  mkParseError = ParseError
  pePositionS :: forall drv . ParseError (Pos String) drv ->
                              (Int, Int)
  pePositionS (ParseError {pePosition = ListPos (CharPos p)}) = p
  class Source sl
      where type Token sl
            data Pos sl
            getToken :: sl -> Maybe ((Token sl, sl))
            initialPos :: Pos sl
            updatePos :: Token sl -> Pos sl -> Pos sl
  class SourceList c
      where data ListPos c
            listToken :: [c] -> Maybe ((c, [c]))
            listInitialPos :: ListPos c
            listUpdatePos :: c -> ListPos c -> ListPos c
  instance SourceList c => Source ([c])
      where type Token ([c]) = c
            newtype Pos ([c]) = ListPos (ListPos c)
            getToken = listToken
            initialPos = ListPos listInitialPos
            updatePos c (ListPos p) = ListPos (listUpdatePos c p)
  instance SourceList Char
      where newtype ListPos Char = CharPos ((Int, Int)) deriving (Show)
            listToken (c : s) = Just (c, s)
            listToken _ = Nothing
            listInitialPos = CharPos (1, 1)
            listUpdatePos '\n' (CharPos (y, _)) = CharPos (y + 1, 1)
            listUpdatePos '\t' (CharPos (y, x)) = CharPos (y,
                                                           ((+ 1) . (* 8) . (+ 1) . (`div` 8) . subtract 1) x)
            listUpdatePos _ (CharPos (y, x)) = CharPos (y, x + 1)
  runError :: forall err a . ErrorT err Identity a -> Either err a
  runError = runIdentity . runErrorT
  
  instance Source BSC.ByteString where
  	type Token BSC.ByteString = Char
  	data Pos BSC.ByteString = NoPos
  	getToken = BSC.uncons
  	initialPos = NoPos
  	updatePos _ _ = NoPos
  