Commits

Alexander Vershilov committed 9523b27

conduit interface added

  • Participants
  • Parent commits 5b7b3f8

Comments (0)

Files changed (3)

+dist
+cabal-dev

File Language/Cpp/GccXml/Conduit.hs

+{-# LANGUAGE OverloadedStrings #-}
+module Language.Cpp.GccXml.Conduit
+    where
+
+import Data.Conduit
+import Data.Conduit.List as CL
+import Data.Monoid
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Text
+
+import Language.Cpp.GccXml
+import Language.Cpp.GccXml.Types
+import Language.Cpp.GccXml.Utils
+
+
+byId :: (Monad m) => CodeMap -> Conduit ID m Declaration 
+byId state0  = conduitState state0 push close
+    where
+        push state idx = 
+            return $ StateProducing state $ maybe [] (:[]) (M.lookup idx state)
+        close _ = return []
+
+-- | Event list of messages that generate Class 
+data ClassEvent = ClassEventName Text               -- ^ Class name
+                | ClassEventMethod MethodData       -- ^ List of class methods
+                deriving (Show)                 
+
+sourceClass :: (Monad m) => CodeMap -> Declaration -> Source m ClassEvent
+sourceClass sourceTree (Class (ClassData name _align _size members _supers)) = 
+         mconcat [ CL.sourceList [ClassEventName name]
+                 , CL.sourceList members 
+                       $= byId sourceTree
+                       $= process
+                 ]
+    where
+        process = conduitState () push close
+            where
+                push _ v | isMethod v = do
+                    r <- sourceMethod sourceTree v $$ sinkMethod
+                    return $ StateProducing () [ClassEventMethod r]
+                         | otherwise  = return $ StateProducing () []
+                close _ = return []
+sourceClass _ _ = error "not a class"
+
+-- | Stores Method data 
+data MethodData = MethodData
+    { methodName :: Text
+    , methodAccess :: Access
+    , methodType   :: TypeData 
+    , methodParams :: [Maybe TypeData]
+    }
+    deriving (Show)
+
+
+data MethodEvent = MethodEventDecl Text
+                 | MethodEventType TypeData
+                 | MethodEventAccess Access
+                 | MethodEventParam  (Maybe TypeData)
+
+-- Method       Text Text Access ID [Maybe ID]   
+sourceMethod :: (Monad m) => CodeMap -> Declaration -> Source m MethodEvent
+sourceMethod code (Method name _mang access refType params) = do
+    mt <- sourceParam code (fromJust $ M.lookup refType code) $$ sinkParam
+    mconcat [ CL.sourceList [ MethodEventDecl name
+                            , MethodEventType mt
+                            , MethodEventAccess access
+                            ]
+            , CL.sourceList params $= CL.mapM (\x -> do 
+                                                  p <- readParam x
+                                                  return $ MethodEventParam p
+                                              )
+            ]
+    where 
+        readParam :: (Monad m) => Maybe ID -> m (Maybe TypeData)
+        readParam Nothing  = return Nothing
+        readParam (Just i) = 
+            case M.lookup i code of
+                Nothing -> return Nothing
+                Just x  -> do p <- sourceParam code x $$ sinkParam
+                              return $ Just p
+sourceMethod sourceTree _ = error "not a method"
+
+sinkMethod :: (Monad m) => Sink MethodEvent m MethodData 
+sinkMethod = sinkState def push close
+    where
+        def = MethodData undefined undefined undefined []
+        push method item = 
+            return $ 
+                case item of
+                   (MethodEventDecl name) -> StateProcessing method{methodName = name} 
+                   (MethodEventType idx)  -> StateProcessing method{methodType = idx}
+                   (MethodEventAccess acc)-> StateProcessing method{methodAccess = acc}
+                   (MethodEventParam idx) -> StateProcessing method{methodParams = idx:methodParams method}
+        close method = return method
+
+data TypeData  = CFundamentalType Text
+               | CReferenceType   TypeData
+               deriving (Show)
+data TypeEvent = EventTypeFundamental Text
+               | EventTypeReference   
+{-
+  | FundametalType Text
+    -- ^ Basic C++ type
+  | PointerType     ID
+    -- ^ Declaration of pointer type
+  | ReferenceType   ID
+    -- ^ Reference to type 
+  | ArrayType       ID Text
+    -- ^ Array: type and size in textual form
+  | FunctionType ID [Maybe ID]
+    -- ^ Pointer to function. Return type and argument type
+  | CvQualifiedType ID Bool Bool
+    -- ^ Const/volatile qualifier: type
+  | Typedef Text ID  
+    -- ^ Typedef: typedef name, type it points to
+-}
+
+sourceParam :: (Monad m) => CodeMap -> Declaration -> Source m TypeEvent
+sourceParam code (FundamentalType name) = sourceList [EventTypeFundamental name]
+sourceParam code (ReferenceType   idx)  = 
+    let p = M.lookup idx code
+        c = maybe (sourceList []) (sourceParam code) p
+    in CL.sourceList [EventTypeReference] 
+        `mappend` c
+
+sinkParam :: (Monad m) => Sink TypeEvent m TypeData
+sinkParam = do
+    n <- CL.head
+    case n of
+        Just (EventTypeFundamental t) -> return $ CFundamentalType t
+        Just (EventTypeReference)     -> do 
+                                           n' <- sinkParam
+                                           return $ CReferenceType n'
+                                
+
+

File gccxml.cabal

 library
   exposed-modules:     Language.Cpp.GccXml, Language.Cpp.GccXml.XML,
                        Language.Cpp.GccXml.Types, Foreign.Cpp.Call,
-                       Language.Cpp.GccXml.Utils
+                       Language.Cpp.GccXml.Utils, Language.Cpp.GccXml.Conduit
   -- other-modules:       
   build-depends:       base ==4.5.*, 
                        transformers ==0.3.*,