diff --git a/CodeGenTest.hs b/CodeGenTest.hs index 3eb9dade69ea25a633819f9c6c7b6637d2eaf786..bd986a80990e40acd355fe2bffcf6aa8fe04a2bf 100644 --- a/CodeGenTest.hs +++ b/CodeGenTest.hs @@ -39,12 +39,16 @@ enumOf2Enum lst (DerivedType n (ENUMERATION_OF t)) in DerivedType n . selection2Enum $ selection enumOf2Enum lst a = a +-- filter out lookup-name since its target is non-existant +g :: ProtocolAItem -> Bool +g (RequestAlias _ "lookup-name") = False +g _ = True main :: IO () main = do d <- parseFromFile documentParser "/usr/share/doc/lyskom/protocol-a-full.txt" let dat = sortOn proc $ head $ rights [d] - let dat' = map (enumOf2Enum dat) dat + let dat' = filter g $ map (enumOf2Enum dat) dat -- runQ (return $ concat $ map f dat) >>= putStrLn.pprint -- {-# LANGUAGE DuplicateRecordFields #-} diff --git a/LysKom/Internal/CodeGen.hs b/LysKom/Internal/CodeGen.hs index 9fda9db912a5699c308ee67ff72d35d01e2d9539..6690424c28de0a9eae629067e6c63bc7dabcec70 100644 --- a/LysKom/Internal/CodeGen.hs +++ b/LysKom/Internal/CodeGen.hs @@ -28,12 +28,21 @@ typename (s:xs) = toUpper s : f xs f (c:xs) = c : f xs -- varname "last-time-read" ⇒ "lastTimeRead" -varname [] = [] -varname "data" = "data_" -varname "type" = "type_" +varname [] = "" +-- data and type are reserved in haskell, this is next best thing +varname "data" = "data'" +varname "type" = "type'" +-- name conflict with between requests and fields. +-- rename these and let requests keep their "proper" names +varname "change-name" = "changeName'" +varname "create-conf" = "createConf'" varname ('-':c:xs) = toUpper c : varname xs varname (c:xs) = c : varname xs +fname ('-':c:xs) = toUpper c : varname xs +fname (c:xs) = c : varname xs +fname [] = "" + b = Bang NoSourceUnpackedness NoSourceStrictness lystype :: LysType -> Type @@ -101,7 +110,7 @@ f (DerivedType name (SELECTION opts)) = do let className = mkName . typename $ name options <- (flip mapM) opts $ \(i,fn,(n,t)) -> do - fieldname <- newName . varname $ fn + fieldname <- newName . fname $ fn let constructorName = mkName . typename $ n body <- [| intDec i <> char7 ' ' <> encode $(return . VarE $ fieldname) |] return ( constructorName, i, fieldname, lystype t, body ) @@ -163,7 +172,7 @@ f (DerivedType name typ@(STRUCTURE t)) = do f (DerivedType name typ@(BITSTRING t)) = do let n = mkName . typename $ name - gens <- mapM newName $ varname <$> t + gens <- mapM newName $ fname <$> t encode <- [| encode |] body <- [| mconcat $ $(return . ListE $ (AppE encode) . VarE <$> gens) |] @@ -189,7 +198,7 @@ f (DerivedType name typ@(BITSTRING t)) = do f (DerivedType name t) = return [TySynD (mkName . typename $ name) [] $ lystype t] f (Request name n args ret) = do - let nn = mkName . varname $ name + let nn = mkName . fname $ name syms <- sequence [ newName . varname $ n | (n,_) <- args ] sp <- [| char7 ' ' |] body <- case syms of @@ -221,10 +230,9 @@ f (Other _) = return [] f (TypeAlias old new) = return [ TySynD (mkName . typename $ new) [] $ ConT (mkName . typename $ old) ] -f (RequestAlias _ _) = return [] --- f (RequestAlias old new) = return [ ValD (VarP . mkName . typename $ new) --- (NormalB . VarE . mkName . typename $ old) --- [] ] +f (RequestAlias old new) = return [ ValD (VarP . mkName . fname $ new) + (NormalB . VarE . mkName . fname $ old) + [] ] f (AsyncAlias _ _) = return [] -- f (AsyncAlias old new) = return [ ValD (VarP . mkName . typename $ new) -- (NormalB . VarE . mkName . typename $ old)