PGM Parser - Not Complete

{-# LANGUAGE OverloadedStrings #-}

import Data.Image
import Data.Int
import System.Environment
import System.FilePath.Posix
import Control.Applicative
import Control.Monad.State.Lazy
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Internal as I
import Data.Word8

imgInPath :: FilePath -> IO FilePath
imgInPath i = combine <$> getEnv "PWD" <*> return i

data Header = Header { format :: [Word8],
              width :: Int64,
              height :: Int64,
              maxGrayValue :: Int64
            }
            deriving (Show)

data PGMFormat = PGMFormat { header :: Maybe Header,
                             body :: Maybe LB.ByteString
                           }
data PGM = P1 PGMFormat
         | P2 PGMFormat
         | P3 PGMFormat
         | P4 PGMFormat
         | P5 PGMFormat
         | P6 PGMFormat

-- | ParserState
-- | State which stores info about the parser:
-- |    parsed:    Value yet parsed
-- |    toParse:   Value to parse
-- |    offset:    Current offset in paring
data ParserState = ParserState { parsed :: LB.ByteString
                               , toParse :: LB.ByteString
                               , offset :: Int64
                               }
                   deriving (Show)

parserState :: LB.ByteString -> ParserState
parserState = (flip $ ParserState "") 0

type PGMState = State ParserState

parseWhile :: (Word8 -> Bool) -> PGMState LB.ByteString
parseWhile f = do
  parserSt <- get
  let (Just (b, bss)) = LB.uncons $ toParse parserSt
  put $ ParserState (LB.cons b $ parsed parserSt) bss ((+1) $ offset parserSt)
  case f b of
    True -> parseWhile f
    False -> do
      put $ parserSt { parsed = "" }
      return $ LB.reverse $ parsed parserSt

parseWord :: PGMState LB.ByteString
parseWord = parseWhile (not . notWhite) >> parseWhile notWhite

parseInt64 :: PGMState (Maybe Int64)
parseInt64 = parseWord >>= f
  where
    f x = return $ (fromInteger <$> fst <$> C.readInteger (B.concat $ LB.toChunks x))

notWhite = not . I.isSpaceWord8

parsePGMHeader :: PGMState Header
parsePGMHeader =  do
    f <- parseWord
    (Just w) <- parseInt64
    (Just h) <- parseInt64
    (Just g) <- parseInt64
    return $ Header (LB.unpack f) w h g

-- parsePGM2 = do
--   header <- parsePGMHeader
--   (bs, o) <- get
--   return o