Discovered the palette parser is using polyparse, not parsec.

Blobs.cabal

@@ -5,7 +5,7 @@ Author:          Arjan van IJzendoorn, Martijn Schrage, Malcolm Wallace
 Description:     Diagram editor
 Homepage:        http://www.cs.york.ac.uk/fp/darcs/Blobs/
 Build-Depends:   base, haskell98, wx >= 0.9, wxcore >= 0.9, HaXml >= 1.14
-                 , parsec, directory, pretty, containers
+                 , polyparse, directory, pretty, containers
                  -- , lang
 
 executable: blobs

src/Colors.hs

@@ -1,19 +1,18 @@
 module Colors where
 
 import Graphics.UI.WX
---import Text.ParserCombinators.TextParser
-import Text.Parsec
-import Text.Parsec.Char
+import Text.Parse
+
 
 -- Different spelling of colour/color to distinguish local/wx datatypes.
 data Colour = RGB !Int !Int !Int deriving (Eq,Show,Read)
 
-{-
+
 instance Parse Colour where
   parse = do { isWord "RGB"
              ; return RGB `apply` parse `apply` parse `apply` parse
              }
--}
+
 -- translate local to wx
 wxcolor :: Colour -> Color
 wxcolor (RGB r g b) = rgb r g b

src/ContextMenu.hs

@@ -11,14 +11,13 @@ import Math (DoublePoint)
 import qualified PersistentDocument as PD
 import Palette
 import InfoKind
---import Text.ParserCombinators.TextParser
-import Text.Parsec hiding (State)
+import Text.Parse
 
 import Graphics.UI.WX
 import Graphics.UI.WXCore(windowGetMousePosition)
 
 -- | Context menu for empty area of canvas
-canvas :: (InfoKind n g, Show g,{- Parse g,-} Descriptor g) =>
+canvas :: (InfoKind n g, Show g, Parse g, Descriptor g) =>
           Frame () -> State g n e -> IO ()
 canvas theFrame state =
   do{ contextMenu <- menuPane []

src/GUIEvents.hs

@@ -10,13 +10,12 @@ import Document
 import qualified ContextMenu
 import qualified PersistentDocument as PD
 import InfoKind
---import Text.ParserCombinators.TextParser
-import Text.Parsec hiding (State)
+import Text.Parse
 
 import Graphics.UI.WX
 import Graphics.UI.WXCore
 
-mouseDown :: (InfoKind n g, InfoKind e g, Show g, {-Parse g,-} Descriptor g) =>
+mouseDown :: (InfoKind n g, InfoKind e g, Show g, Parse g, Descriptor g) =>
              Bool -> Point -> Frame () -> State g n e -> IO ()
 mouseDown leftButton mousePoint theFrame state =
   do{ pDoc <- getDocument state

src/InfoKind.hs

@@ -4,16 +4,15 @@
 {-# LANGUAGE UndecidableInstances #-}
 module InfoKind where
 
---import Text.ParserCombinators.TextParser
-import Text.Parsec
+import Text.Parse
 import Text.XML.HaXml.XmlContent
 
 -- | The @InfoKind@ class is a predicate that ensures we can always create
 --   at least a blank (empty) information element, that we can read and
 --   write them to/from the user, and that there exists some method of
 --   determining the correctness of the value (completeness/consistency etc)
 --   against some global type.
-class (Eq a, Show a {-, Parse a, XmlContent a -}) => InfoKind a g | a -> g where
+class (Eq a, Show a, Parse a{-, XmlContent a -}) => InfoKind a g | a -> g where
     blank :: a
     check :: String -> g -> a -> [String]		-- returns warnings
 	-- ^ first arg is container label for error reporting.

src/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 module Main (main, gain) where
 
 import NetworkUI

src/Math.hs

@@ -16,8 +16,7 @@ module Math
     ) where
 
 import Graphics.UI.WX(Point, point, pointX, pointY)
---import Text.ParserCombinators.TextParser
-import Text.Parsec
+import Text.Parse
 
 {-
 data DoublePoint = DoublePoint
@@ -29,12 +28,10 @@ data DoublePoint = DoublePoint
 data DoublePoint = DoublePoint !Double !Double
     deriving (Show, Eq, Read)
 
-{-
 instance Parse DoublePoint where
     parse = do { isWord "DoublePoint"
                ; return DoublePoint `apply` parse `apply` parse
                }
--}
 
 data Vector = Vector !Double !Double
 

src/NetworkControl.hs

@@ -27,8 +27,7 @@ import Shape
 import qualified PersistentDocument as PD
 import InfoKind
 import Palette (shapes)
---import Text.ParserCombinators.TextParser as Parse
-import Text.Parsec as Parse hiding (State,getPosition,setPosition)
+import Text.Parse
 import Char (isSpace)
 
 import Graphics.UI.WX hiding (Selection)
@@ -399,9 +398,8 @@ reArityNode theFrame state =
                                          "Change arity of node" (show oldArity)
                                          True
                 ; ifJust result $ \newArity ->
-                    do repaintAll state -- Until we sort out the parser
-                  {-
-                  case Parse.runParser Parse.parse newArity of
+                    -- do repaintAll state -- Until we sort out the parser
+                  case runParser parse newArity of
                     (Right x, s) ->
                         do{ when (not (null s || all isSpace s)) $
                                 errorDialog theFrame "Edit warning"
@@ -416,7 +414,6 @@ reArityNode theFrame state =
                                           ("Cannot parse entered text."
                                           ++"\nReason: "++err
                                           ++"\nRemaining text: "++s)
-                   -}
                 }
         _ -> return ()
     }
@@ -433,10 +430,8 @@ reinfoNodeOrEdge theFrame state =
             ; result <- myTextDialog theFrame MultiLine
                                      "Edit node info" (show oldInfo) True
             ; ifJust result $ \newInfo ->
-                  do repaintAll state -- Until we sort out the parser
-
-                  {-
-                  case Parse.runParser Parse.parse newInfo of
+                  -- do repaintAll state -- Until we sort out the parser
+                  case runParser parse newInfo of
                     (Right x, s) ->
                         do{ when (not (null s || all isSpace s)) $
                                 errorDialog theFrame "Edit warning"
@@ -457,16 +452,14 @@ reinfoNodeOrEdge theFrame state =
                                           ("Cannot parse entered text."
                                           ++"\nReason: "++err
                                           ++"\nRemaining text: "++s)
-                    -}
             }
         EdgeSelection edgeNr ->
           do{ let oldInfo = getEdgeInfo (getEdge edgeNr network)
             ; result <- myTextDialog theFrame MultiLine
                                      "Edit edge info" (show oldInfo) True
             ; ifJust result $ \newInfo ->
-                  do repaintAll state -- Until we sort out the parser
-                  {-
-                  case Parse.runParser Parse.parse newInfo of
+                  -- do repaintAll state -- Until we sort out the parser
+                  case runParser parse newInfo of
                     (Right x, s) ->
                         do{ when (not (null s || all isSpace s)) $
                                 errorDialog theFrame "Edit warning"
@@ -487,12 +480,11 @@ reinfoNodeOrEdge theFrame state =
                                           ("Cannot parse entered text."
                                           ++"\nReason: "++err
                                           ++"\nRemaining text: "++s)
-                  -}
             }
         _ -> return ()
     }
 
-changeGlobalInfo :: (Show g, {- Parse g,-} Descriptor g) =>
+changeGlobalInfo :: (Show g, Parse g, Descriptor g) =>
                     Frame () -> State g n e -> IO ()
 changeGlobalInfo theFrame state =
   do{ pDoc <- getDocument state
@@ -502,10 +494,8 @@ changeGlobalInfo theFrame state =
     ; result <- myTextDialog theFrame MultiLine ("Edit "++descriptor info)
                              (show info) True
     ; ifJust result $ \newInfo->
-                        do repaintAll state -- Until we sort out the parser
-
-          {-
-          case Parse.runParser Parse.parse newInfo of
+                        --do repaintAll state -- Until we sort out the parser
+          case runParser parse newInfo of
             (Right x, s) ->
                 do{ when (not (null s || all isSpace s)) $
                         errorDialog theFrame "Edit warning"
@@ -519,6 +509,5 @@ changeGlobalInfo theFrame state =
                                   ("Cannot parse entered text."
                                   ++"\nReason: "++err
                                   ++"\nRemaining text: "++s)
-          -}
     }
 

src/NetworkUI.hs

@@ -19,8 +19,7 @@ import Palette
 import InfoKind
 import DisplayOptions
 import Text.XML.HaXml.XmlContent (XmlContent)
---import Text.ParserCombinators.TextParser as Parse
-import Text.Parsec as Parse hiding (State)
+import Text.Parse
 import Operations
 import NetworkControl (changeGlobalInfo)
 
@@ -51,7 +50,7 @@ getConfig state =
     }
 
 create :: (InfoKind n g, InfoKind e g
-          , {-XmlContent g,-} {-Parse g,-} Show g, Descriptor g) =>
+          , {-XmlContent g,-} Parse g, Show g, Descriptor g) =>
           State g n e -> g -> n -> e -> GraphOps g n e -> IO ()
 create state g n e ops =
   do{ theFrame <- frame [ text := "Diagram editor"
@@ -257,7 +256,7 @@ paintHandler state dc =
 extensions :: [(String, [String])]
 extensions = [ ("Blobs files (.blobs)", ["*.blobs"]) ]
 
-mouseEvent :: (InfoKind n g, InfoKind e g, Show g, {-Parse g,-} Descriptor g) =>
+mouseEvent :: (InfoKind n g, InfoKind e g, Show g, Parse g, Descriptor g) =>
               EventMouse -> ScrolledWindow () -> Frame () -> State g n e -> IO ()
 mouseEvent eventMouse canvas theFrame state = case eventMouse of
     MouseLeftDown mousePoint mods
@@ -372,7 +371,7 @@ openNetworkFile fname state exceptionsFrame =
     ; repaintAll state
     }}}
 
-openPalette :: (InfoKind n g{-, Parse n-}) => Frame () ->  State g n e -> IO ()
+openPalette :: (InfoKind n g, Parse n) => Frame () ->  State g n e -> IO ()
 openPalette theFrame state =
   do{ mbfname <- fileOpenDialog
         theFrame
@@ -386,7 +385,7 @@ openPalette theFrame state =
 
 -- Third argument: Nothing means exceptions are ignored (used in Configuration)
 --              Just f means exceptions are shown in a dialog on top of frame f
-openPaletteFile :: (InfoKind n g{-, Parse n-}) =>
+openPaletteFile :: (InfoKind n g, Parse n) =>
                    String -> State g n e -> Maybe (Frame ()) -> IO ()
 openPaletteFile fname state exceptionsFrame =
   flip catch
@@ -397,8 +396,7 @@ openPaletteFile fname state exceptionsFrame =
                     ++ "Reason: " ++ show exc)
     ) $
   do{ contents <- readFile fname
-    ; return () -- Dummy out for now
-    {-
+    -- ; return () -- Dummy out for now
     ; case fst (runParser parse contents) of {
         Left msg -> ioError (userError ("Cannot parse shape palette file: "
                                        ++fname++"\n\t"++msg));
@@ -410,7 +408,6 @@ openPaletteFile fname state exceptionsFrame =
                              pDoc
                       }
     }
-    -}
     }
 
 -- | Get the canvas size from the network and change the size of

src/Palette.hs

@@ -2,8 +2,7 @@ module Palette where
 
 import List (nub, (\\))
 import Shape
--- import Text.ParserCombinators.TextParser as Parse
-import Text.Parsec as Parse
+import Text.Parse
 
 data Palette a = Palette [ (String, (Shape, Maybe a)) ]
   deriving (Eq, Show, Read)
@@ -24,7 +23,7 @@ empty = Palette [("circle", (Shape.circle, Nothing))]
 instance Functor Palette where
     fmap _ (Palette p) = Palette (map (\ (n,(s,i))-> (n,(s,Nothing))) p)
 
-{-
+
 instance Parse a => Parse (Palette a) where
     parse = do{ isWord "Palette"; fmap Palette $ parse }
--}
+

src/Shape.hs

@@ -5,8 +5,7 @@ import Graphics.UI.WX as WX
 import Graphics.UI.WXCore hiding (Colour)
 import Graphics.UI.WXCore.Draw
 import Math
---import Text.ParserCombinators.TextParser
-import Text.Parsec
+import Text.Parse
 --import Text.XML.HaXml.XmlContent
 --import NetworkFile
 
@@ -29,7 +28,7 @@ data ShapeStyle = ShapeStyle
     }
   deriving (Eq, Show, Read)
 
-{-
+
 instance Parse Shape where
   parse = oneOf
       [ do{ isWord "Circle"
@@ -65,7 +64,7 @@ instance Parse ShapeStyle where
                 `discard` isWord "," `apply` field "styleFill"
                 `discard` isWord "}"
             }
--}
+
 
 {-
 instance HTypeable Shape where