Commits

Alexander Vershilov  committed f148d95

port to conduit

  • Participants
  • Parent commits ec0b2c1

Comments (0)

Files changed (5)

File Foreign/Cpp/Call.hs

 
 -- | Object's destructor.
 class Destructor obj where
-  delete :: Object obj -> IO ()w
+  delete :: Object obj -> IO ()
 
 newtype Member method args = Member args
 
+Copyright (c) <YEAR>, <OWNER>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice,
+   this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the <ORGANIZATION> nor the names of its
+   contributors may be used to endorse or promote products derived from
+   this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.

File Language/Cpp/GccXml.hs

 -- > Union
 -- > Variable
 
+import Prelude hiding (FilePath)
 import Control.Applicative( (<$), (<$>), Applicative(..), (<|>), (<*), (*>), optional )
 import Control.Arrow
 import Control.Monad.IO.Class
 import Data.Char
 import Data.Text                (Text,split,empty,unpack)
 import qualified Data.Text as T
-import Data.Enumerator          (Iteratee)
+import Data.Conduit
 import Data.XML.Types           (Event,Name)
+import Data.Void 
+import Filesystem.Path (FilePath)
 
-import Text.XML.Enumerator.Parse
+import Text.XML.Stream.Parse 
 
                           
 import Language.Cpp.GccXml.XML
 ----------------------------------------------------------------
 
 -- Simple declaration
-simpleDecl :: Monad m => Name -> AttrParser a -> Iteratee Event m (Maybe (ID,a))
+simpleDecl :: MonadThrow m => Name -> AttrParser a -> Sink Event m (Maybe (ID,a))
 simpleDecl nm att = subdecl nm ((,) <$> paramID "id" <*> att)
 
 -- Declaration with nested elements
-declaration :: (Monad m) 
+declaration :: (MonadThrow m) 
             => Name
             -> AttrParser ([x] -> a)
-            -> Iteratee Event m (Maybe x)
-            -> Iteratee Event m (Maybe (ID, a))
+            -> Sink Event m (Maybe x)
+            -> Sink Event m (Maybe (ID, a))
 declaration nm atts chld =
   tagName nm (ignore $ (,) <$> paramID "id" <*> atts) $ \(i,f) -> do
     xs <- many chld
     return (i, f xs)
 
 -- Subdeclaration
-subdecl :: Monad m
+subdecl :: MonadThrow m
         => Name 
         -> AttrParser a
-        -> Iteratee Event m (Maybe a)
+        -> Sink Event m (Maybe a) 
+{-
+subdecl :: forall (m :: * -> *) b.
+           MonadThrow m =>
+           Name -> AttrParser b -> Sink Event m (Maybe b)-}
 subdecl nm att = tagName nm (ignore att) return 
 
 -- Ignore everything
-ignoreTags :: Monad m => Iteratee Event m (Maybe ())
+-- ignoreTags :: Monad m => Iteratee Event m (Maybe ())
+ignoreTags :: Sink Event (ResourceT IO) (Maybe ())
 ignoreTags = tagPredicate (const True) ignoreAttrs (const $ () <$ many ignoreTags) 
 
 ----------------------------------------------------------------
 
 -- Parse argument list of a function
-argumentList :: MonadIO m => Iteratee Event m (Maybe (Maybe ID))
+argumentList :: Sink Event (ResourceT IO) (Maybe (Maybe ID))
 argumentList = choose [ subdecl   "Argument" $ (Just <$> paramID "type")
                       , tagNoAttr "Ellipsis" (return Nothing)
                       ]
 
 -- Parse class
-parseClass :: MonadIO m => Iteratee Event m (Maybe (ID, Declaration))
+parseClass :: Pipe
+              Event Void (ResourceT IO) (Maybe (ID, Declaration))
 parseClass = 
   fmap (second Class) <$> 
   ( declaration "Class" 
   )
 
 -- Class method
-parseMethod :: MonadIO m => Iteratee Event m (Maybe (ID, Declaration))
+-- parseMethod :: MonadIO m => Iteratee Event m (Maybe (ID, Declaration))
+parseMethod :: Sink Event (ResourceT IO) (Maybe (ID, Declaration))
 parseMethod = 
   declaration "Method" 
   (Method <$> requireAttr "name" <*> requireAttr "mangled" <*> paramAccess "access" <*> paramID "returns")
   argumentList
 
 -- Constructor
-parseConstructor :: MonadIO m => Iteratee Event m (Maybe (ID, Declaration))
+parseConstructor :: Sink
+                    Event (ResourceT IO) (Maybe (ID, Declaration))
 parseConstructor =
   declaration "Constructor"
   (Constructor <$> requireAttr "mangled" <*> paramAccess "access")
   argumentList
 
 -- Function
-parseFunction :: MonadIO m => Iteratee Event m (Maybe (ID, Declaration))
+parseFunction :: Sink
+                 Event (ResourceT IO) (Maybe (ID, Declaration))
 parseFunction = 
   declaration "Function" 
   (Function <$> requireAttr "name" <*> optionalAttr "mangled" <*> paramID "returns")
   
   
 ----------------------------------------------------------------
+parseGccXml :: Sink Event (ResourceT IO) (Maybe [(ID, Declaration)])
 parseGccXml = tagName "GCC_XML" ignoreAttrs $ const $ many 
             $ choose [ simpleDecl "Namespace" (Namespace <$> requireAttr "name" <*> paramIdList "members")
                        -- Declarations
                      ]
 
 
-
--- go :: IO ()
+listGCCXml :: FilePath -> IO [(ID, Declaration)]
+listGCCXml s = 
+    runResourceT $ parseFile def s $$  force "GCC XML" parseGccXml
+    
+go :: FilePath -> IO ()
 go s = do
-  q <- parseFile_ s decodeEntities $ force "GCC XML" parseGccXml
+  q <- runResourceT $ parseFile  def s $$ force "GCC XML" parseGccXml
   mapM_ print $ filter ((/= JUNK) . snd) q

File Language/Cpp/GccXml/XML.hs

 import Data.XML.Types             (Name)
 import Data.Text                  (unpack,words)
 
-import Text.XML.Enumerator.Parse
+--import Text.XML.Enumerator.Parse
+import Text.XML.Stream.Parse
 import Prelude                    hiding (words)
 
 import Language.Cpp.GccXml.Types
+import Distribution.Simple
+main = defaultMain