Synnefo » snf-ganeti

import qualified Text.JSON as JSON

-- | Ensure first letter is lowercase.

--

-- Used to convert type name to function prefix, e.g. in @data Aa ->

ensureLower [] = []

ensureLower (x:xs) = toLower x:xs

-- | ToString function name.

toStrName :: String -> Name

toStrName = mkName . (++ "ToString") . ensureLower

-- | Converts a name to it's varE/litE representations.

--

reprE :: Either String Name -> Q Exp

-- | Generates a data type declaration.

--

               JSON.Ok s' -> $(varE (fromStrName name)) s'

               JSON.Error e ->

                   JSON.Error $ "Can't parse string value for type " ++

           |]

  return $ FunD (mkName "readJSON") [Clause [VarP s] (NormalB body) []]

  readJ <- genReadJSON base

  return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) (readJ:showJ)]

-- | Transforms a CamelCase string into an_underscore_based_one.

deCamelCase :: String -> String

deCamelCase =

          -> Q Exp

saveField fvar (fname, qt, _) = do

  t <- qt

      fvare = varE fvar

  (if isOptional t

   then [| case $fvare of

             Nothing -> []

         |]

-- | Generates the \"save\" clause for an entire opcode constructor.

--

  let pat = conP cname (map varP fnames)

  let felems = map (uncurry saveField) (zip fnames fields)

      -- now build the OP_ID serialisation

      flist = listE (opid:felems)

      -- and finally convert all this to a json object

  clause [pat] (normalB flist') []

-- | Generates the main save opcode function.

  t <- qt

  defa <- qdefa

  -- these are used in all patterns below

  bexp <- if isOptional t

          else case defa of

                 AppE (ConE dt) defval | dt == 'Just ->

                   -- but has a default value

                      $objvar $objfield $(return defval) |]

                 ConE dt | dt == 'Nothing ->

                 s -> fail $ "Invalid default value " ++ show s ++

                      ", expecting either 'Nothing' or a 'Just defval'"

  return (fvar, BindS (VarP fvar) bexp)

      opid = mkName "op_id"

  st1 <- bindS (varP objname) [| liftM JSON.fromJSObject

                                 (JSON.readJSON $(varE arg1)) |]

  -- the match results (per-constructor blocks)

  mexps <- mapM (uncurry loadConstructor) opdefs

  fails <- [| fail $ "Unknown opcode " ++ $(varE opid) |]