#!/bin/runghc

-- page 238 in Real Time Haskell
-- first revision to get rid of boilerplate
-- Tom Trebisky  4-16-2018

import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.Char (isSpace)

-- pgm_file = "img0001.pgm"
pgm_file = "test.pgm"

data Greymap = Greymap {
    gWidth :: Int,
    gHeight :: Int,
    gMax :: Int,
    gData :: L.ByteString
} deriving (Eq)

instance Show Greymap where
    show (Greymap w h m buf) = "Greymap: " ++ show w ++ " by " ++ show h ++
            " max = " ++ show m ++
            " ( " ++ (show $ L.length buf) ++ " bytes )"

-- I change the return value to pass a dummy count for skipSpace
-- and I rip out the implicit internal skipSpace
matchHeader :: L.ByteString -> L.ByteString -> Maybe (Int,L.ByteString)
matchHeader prefix str
    | prefix `L8.isPrefixOf` str
--        = Just (0,L8.dropWhile isSpace (L.drop (L.length prefix) str ))
        = Just (123,L.drop (L.length prefix) str )
    | otherwise = Nothing

getNat :: L.ByteString -> Maybe (Int, L.ByteString)
getNat s = case L8.readInt s of
    Nothing -> Nothing
    Just (num,rem)
        | num <= 0 -> Nothing
        | otherwise -> Just (fromIntegral num, rem)

getBytes :: Int -> L.ByteString -> Maybe (L.ByteString, L.ByteString)
getBytes n str = let count = fromIntegral n
                     both@(prefix,_) = L.splitAt count str
                 in if L.length prefix < count
                    then Nothing
                    else Just both

(>>?) :: Maybe a -> (a -> Maybe b) -> Maybe b
Nothing >>? _ = Nothing
Just x >>? f = f x

-- This carries along "a" as extra baggage
skipSpace :: (a, L.ByteString) -> Maybe (a, L.ByteString)
skipSpace (a,s) = Just ( a, L8.dropWhile isSpace s)

parseP5 :: L.ByteString -> Maybe (Greymap, L.ByteString)
parseP5 s =
    matchHeader (L8.pack "P5") s >>?
--    \s -> skipSpace ((), s)      >>?
--    (getNat . snd )              >>?
    skipSpace                    >>?
    \(_,s) -> getNat s           >>?
    skipSpace                    >>?
    \(w,s) -> getNat s           >>?
    skipSpace                    >>?
    \(h,s) -> getNat s           >>?
    \(max,s) -> getBytes 1 s     >>?
    (getBytes (w*h) . snd)       >>?
    \(map,s) -> Just (Greymap w h max map, s)

wrapper :: L.ByteString -> Greymap
wrapper s =
    case rv of
        Nothing -> Greymap 9 9 99 pad
        Just (x,_) -> x
    where
        rv = parseP5 s
        pad = L8.pack "xxx"

main = do
        input <- L.readFile pgm_file
        putStrLn pgm_file
        putStrLn $ show $ L.length input
        let gm = wrapper input
--        let report = "OK: max = " ++ (show $ gMax gm)
        let report = "OK: " ++ (show gm)
        putStrLn report
        putStrLn "done"

--  THE END