PARSER: use attoparsec instead of our own implementation

This also uses ByteStringS and might be faster.

CG2.cabal

@@ -63,7 +63,6 @@ executable Gtk
                        Graphics.Diagram.Types
                        GUI.Gtk
                        MyPrelude
-                       Parser.Core
                        Parser.Meshparser
                        Parser.PathParser
                        QueueEx
@@ -72,7 +71,9 @@ executable Gtk
   -- other-extensions:
 
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.6 && <4.8,
+  build-depends:       attoparsec >= 0.12.1.1,
+                       base >=4.6 && <4.8,
+                       bytestring >= 0.10.4.0,
                        containers >= 0.5.0.0,
                        dequeue >= 0.1.5,
                        diagrams-lib >=1.2 && <1.3,
@@ -107,7 +108,6 @@ executable Gif
                        Graphics.Diagram.Plotter
                        Graphics.Diagram.Types
                        MyPrelude
-                       Parser.Core
                        Parser.Meshparser
                        Parser.PathParser
                        QueueEx
@@ -117,7 +117,9 @@ executable Gif
   -- other-extensions:
 
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.6 && <4.8,
+  build-depends:       attoparsec >= 0.12.1.1,
+                       base >=4.6 && <4.8,
+                       bytestring >= 0.10.4.0,
                        diagrams-lib >=1.2 && <1.3,
                        diagrams-cairo >=1.2 && <1.3,
                        transformers >=0.4 && <0.5,

Parser/Core.hs

@@ -1,145 +0,0 @@
-{-# OPTIONS_HADDOCK ignore-exports #-}
-
-module Parser.Core (Parser(MkParser),
-               runParser,
-               satisfy,
-               char,
-               string,
-               posInt,
-               posDouble,
-               negDouble,
-               allDouble,
-               oneOrMore,
-               zeroOrMore,
-               spaces) where
-
-import Control.Applicative
-import Data.Char
-import Data.List
-import Data.Maybe
-import MyPrelude
-
-
--- |The parser type. It allows us to create specific parsers,
--- combine them and run them via 'runParser' to get a result.
-newtype Parser a = MkParser { runParser :: String -> Maybe (a, String) }
-
-
--- |Functor instance.
-instance Functor Parser where
-  fmap = inParser . fmap . fmap . first
-
-
--- |Applicative functor instance.
-instance Applicative Parser where
-  pure a               = MkParser (\s -> Just (a, s))
-  (MkParser fp) <*> xp = MkParser $ \s ->
-    case fp s of
-      Nothing    -> Nothing
-      Just (f,x) -> runParser (f <$> xp) x
-
-
--- |Alternative functor instance.
-instance Alternative Parser where
-  empty                       = MkParser (const Nothing)
-  MkParser p1 <|> MkParser p2 = MkParser $ liftA2 (<|>) p1 p2
-
-
-inParser :: ((String -> Maybe (a1, String))
-         -> String
-         -> Maybe (a, String))
-         -> Parser a1
-         -> Parser a
-inParser f p = MkParser . f . runParser $ p
-
-
--- |Creates a Parser that parses a Char depending on a given condition.
-satisfy :: (Char -> Bool) -- ^ condition
-        -> Parser Char    -- ^ created Parser
-satisfy p = MkParser f
-  where
-    f [] = Nothing
-    f (x:xs)
-        | p x       = Just (x, xs)
-        | otherwise = Nothing
-
-
--- |Creates a Parser that accepts a given Char.
-char :: Char -> Parser Char
-char c = satisfy (== c)
-
-
--- |Creates a Parser that accepts a given String.
-string :: String -> Parser String
-string str = MkParser f
-  where
-    f []     = Nothing
-    f allstr
-      | str `isPrefixOf` allstr =
-          Just(str, fromJust . stripPrefix str $ allstr)
-      | otherwise = Nothing
-
-
--- |Creates a Parser that accepts positive integers.
-posInt :: Parser Integer
-posInt = MkParser f
-  where
-    f xs
-      | null ns   = Nothing
-      | otherwise = Just (read ns, rest)
-        where (ns, rest) = span isDigit xs
-
-
--- |Creates a Parser that accepts positive doubles.
--- Both 131.31 and 132 are valid.
-posDouble :: Parser Double
-posDouble =
-  (read <$>)                   $
-    (\x y z -> x ++ [y] ++ z) <$>
-    MkParser f                <*>
-    char '.'                  <*>
-    MkParser f                <|>
-    MkParser f
-  where
-    f xs
-      | null ns   = Nothing
-      | otherwise = Just (ns, rest)
-        where (ns, rest) = span isDigit xs
-
-
--- |Creates a Parser that accepts negative doubles.
--- Both -131.31 and -132 are valid.
-negDouble :: Parser Double
-negDouble =
-    (negate <$>)                 $
-      (read <$>)                 $
-      (\x y z -> x ++ [y] ++ z) <$>
-      (char '-' *> MkParser f)  <*>
-      char '.'                  <*>
-      MkParser f                <|>
-      (char '-' *> MkParser f)
-  where
-    f xs
-      | null ns   = Nothing
-      | otherwise = Just (ns, rest)
-        where (ns, rest) = span isDigit xs
-
-
--- |Creates a Parser that accepts both positive and negative doubles.
-allDouble :: Parser Double
-allDouble = negDouble <|> posDouble
-
-
--- |Convert a given Parser to a Parser that accepts zero or more occurences.
-zeroOrMore :: Parser a -> Parser [a]
-zeroOrMore p = oneOrMore p <|> pure []
-
-
--- |Convert a given Parser to a Parser that accepts one or more occurences.
-oneOrMore :: Parser a -> Parser [a]
-oneOrMore p = (:) <$> p <*> zeroOrMore p
-
-
--- |Creates a Parser that accepts spaces.
-spaces :: Parser String
-spaces = zeroOrMore (satisfy isSpace)

Parser/Meshparser.hs

@@ -4,9 +4,10 @@ module Parser.Meshparser (meshToArr, facesToArr) where
 
 import Algebra.VectorTypes
 import Control.Applicative
-import Data.Maybe
+import Data.Attoparsec.ByteString.Char8
+import Data.Either
+import qualified Data.ByteString.Char8 as B
 import Diagrams.TwoD.Types
-import Parser.Core
 
 
 -- |Convert a text String with multiple vertices and faces into
@@ -16,7 +17,7 @@ facesToArr str = fmap (fmap (\y -> meshs str !! (fromIntegral y - 1)))
                       (faces str)
   where
     meshs = meshToArr
-    faces = fmap fst . catMaybes . fmap (runParser parseFace) . lines
+    faces = rights . fmap (parseOnly parseFace) . B.lines . B.pack
 
 
 -- |Convert a text String with multiple vertices into
@@ -24,19 +25,20 @@ facesToArr str = fmap (fmap (\y -> meshs str !! (fromIntegral y - 1)))
 meshToArr :: String   -- ^ the string to convert
           -> [PT]     -- ^ the resulting vertice table
 meshToArr =
-  fmap (p2 . fst)
+  fmap p2
-    . catMaybes
+    . rights
-    . fmap (runParser parseVertice)
+    . fmap (parseOnly parseVertice)
-    . lines
+    . B.lines
+    . B.pack
 
 
 -- |Creates a Parser that accepts a single vertice, such as 'v 1.0 2.0'.
 parseVertice :: Parser (Double, Double)
 parseVertice =
   (,)
-    <$> (char 'v' *> spaces *> allDouble)
+    <$> (char 'v' *> many' space *> double)
-    <*> (spaces *> allDouble)
+    <*> (many' space *> double)
 
 
 parseFace :: Parser [Integer]
-parseFace = char 'f' *> oneOrMore (spaces *> posInt)
+parseFace = char 'f' *> many1' (many' space *> decimal)

Parser/PathParser.hs

@@ -2,38 +2,39 @@
 
 module Parser.PathParser where
 
-import Control.Applicative
-import Parser.Core
 import Algorithms.QuadTree.QuadTree (Quad(NW, NE, SW, SE), Orient(North, South, West, East))
+import Control.Applicative
+import Data.Attoparsec.ByteString.Char8
+import qualified Data.ByteString.Char8 as B
 
 
 -- |Parse a string such as "ne, n, sw, e" into
 -- [Quad NE, Orient North, Quad SW, Orient East].
 stringToQuads :: String -> [Either Quad Orient]
-stringToQuads str = case runParser parsePath str of
+stringToQuads str = case parseOnly parsePath (B.pack str) of
-  Nothing -> []
+  Left _   -> []
-  Just xs -> fst xs
+  Right xs -> xs
   where
-    parsePath = zeroOrMore ((parseQuad <|> parseOrient)
+    parsePath = many' ((parseQuad <|> parseOrient)
-                             <* zeroOrMore (char ',')
+                             <* many' (char ',')
-                             <* spaces)
+                             <* many' space)
 
 
 -- |Parses a string that represents a single squad into the
 -- QuadOrOrient ADT.
 parseQuad :: Parser (Either Quad Orient)
 parseQuad =
-  const (Left NW) <$> (string "nw" <|> string "NW")
+  const (Left NW) <$> (string (B.pack "nw") <|> string (B.pack "NW"))
-    <|> const (Left NE) <$> (string "ne" <|> string "NE")
+    <|> const (Left NE) <$> (string (B.pack "ne") <|> string (B.pack "NE"))
-    <|> const (Left SW) <$> (string "sw" <|> string "SW")
+    <|> const (Left SW) <$> (string (B.pack "sw") <|> string (B.pack "SW"))
-    <|> const (Left SE) <$> (string "se" <|> string "SE")
+    <|> const (Left SE) <$> (string (B.pack "se") <|> string (B.pack "SE"))
 
 
 -- |Parses a string that represents a single Orientation into the
 -- QuadOrOrient ADT.
 parseOrient :: Parser (Either Quad Orient)
 parseOrient =
-  const (Right North) <$> (string "n" <|> string "N")
+  const (Right North) <$> (string (B.pack "n") <|> string (B.pack "N"))
-    <|> const (Right South) <$> (string "s" <|> string "S")
+    <|> const (Right South) <$> (string (B.pack "s") <|> string (B.pack "S"))
-    <|> const (Right West) <$> (string "w" <|> string "W")
+    <|> const (Right West) <$> (string (B.pack "w") <|> string (B.pack "W"))
-    <|> const (Right East) <$> (string "e" <|> string "E")
+    <|> const (Right East) <$> (string (B.pack "e") <|> string (B.pack "E"))