jshack

gistfile1.hs

{-# LANGUAGE TemplateHaskell #-}
module Jshack where
import Language.Haskell.TH
import Data.Maybe
import Control.Applicative((<$>),(<*>))

-- we can allow maybe here fairly naturally, so let's do it.
data Foo = Bar { many::Int, heterogeneous::Maybe String }
-- this is pretty dumb. clearly we can't cope with Baz Float (Maybe Float) (Maybe Int) cleanly without backtracking.
--         | Baz Float (Maybe String)
-- this is still problematic. I think that if we have
--  | Baz Float
--
-- we expect that to be unitary,
-- but 
--  | Baz Float Int
-- should look for an array? Isn't this pretty shitty form anyway?
-- arguably we should do this for 
         | Baz Float 
         | Quux [Foo]
           deriving (Show,Read)
           
data Simple = SCon Int                    

parseSimple = listToMaybe $ mapMaybe (\(key,p) -> lookup key d >>= p) parseables
  where parseables = [("scon", \s -> SCon <$> parseInt )]

-- reifying stuff
-- $(stringE . show =<< qReify ''Simple)

data Struct = Arr [Struct]           
            | Dict [(String,Struct)]
            | Number Int
            | Flt Float
            | Str String
              

              
-- so, this is the chunk that needs to be generated    

parseFoo :: Struct -> Maybe Foo
parseFoo (Dict d) = listToMaybe $ mapMaybe (\(key,p) -> lookup key d >>= p) parseables
  where parseables = [("bar", \s -> Bar <$> (parseRec "many" s >>= parseInt)
                                  <*> return (parseRec "heterogeneous" s >>= parseString))
                     ,("baz", \s -> Baz <$> parseFloat s -- do (ms:s:_) <- parseArr s
                                    --   Baz <$> parseFloat ms <*> parseString s)
                     ,("quux", \s -> Quux <$> (parseArr s >>= mapM parseFoo))]
                     
parseFoo a = Nothing -- Left "expected a dict with Bar, Baz or Quux as keys - got " ++ show a

parseRec k (Dict d) = lookup k d
parseRec _ _ = Nothing

parseInt (Number c) = return c
parseInt _ = Nothing
parseFloat (Flt f) = return f
parseFloat _ = Nothing                     

parseArr (Arr r) = return r
parseArr _ = Nothing

parseString (Str s) = return s
parseString _ = Nothing