FromJSON.hs

module Data.JSON.FromJSON where

import Control.Applicative
import Data.ByteString
import Data.JSON.Stream

newtype Parse a =
  Parse { runParse :: [Event] -> Maybe a }

boo :: Parse a
boo = Parse (const Nothing) 

instance Functor Parse where
  fmap f (Parse p) =
  	Parse $ \evts -> fmap f (p evts)

instance Applicative Parse where
  pure x = Parse $ const (Just x)

  (Parse f) <*> (Parse p) =
    Parse $ \evts ->
      f evts <*> p evts

class FromJSON a where
	fromJSON :: Parse a

instance FromJSON Bool where
  fromJSON = Parse $ \evts ->
    case evts of
      ValueTrue : _  -> Just True
      ValueFalse : _ -> Just False
      _              -> Nothing

instance FromJSON ByteString where
  fromJSON = Parse $ \evts ->
    case evts of
      ValueString s : _ -> Just s
      _                 -> Nothing

newtype Number = Number { num :: ByteString }
  deriving (Eq, Show)

instance FromJSON Number where
  fromJSON = Parse $ \evts ->
    case evts of
      ValueNumber n : _ -> Just (Number n)
      _                 -> Nothing

object' :: Parse a -> [Event] -> Maybe a
object' f (ObjectBegin:rest) = runParse f rest
object' _                  _ = Nothing

field :: FromJSON a => ByteString -> Parse a
field name = Parse go

  -- veeeery wrong!!!!
  where go evts = 
          case evts of
            (Name n:rest) | name == n -> runParse fromJSON rest
            (_:ts) -> go ts
            _ -> Nothing

object :: Parse a -> Parse a
object f = Parse $ object' f

parse :: Parse a -> ByteString -> Maybe a
parse (Parse p) input =
  maybe Nothing (p . fst) (parseValue input)

data Position =
  Position { x :: Number, y :: Number }
  deriving Show

instance FromJSON Position where
  fromJSON = object $ Position <$> field "x" <*> field "y"