diff --git a/CG2.cabal b/CG2.cabal index 331aeeb..490a8a7 100644 --- a/CG2.cabal +++ b/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, diff --git a/Parser/Core.hs b/Parser/Core.hs deleted file mode 100644 index e13dee2..0000000 --- a/Parser/Core.hs +++ /dev/null @@ -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) diff --git a/Parser/Meshparser.hs b/Parser/Meshparser.hs index ff03aee..17174f9 100644 --- a/Parser/Meshparser.hs +++ b/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) - . catMaybes - . fmap (runParser parseVertice) - . lines + fmap p2 + . rights + . fmap (parseOnly parseVertice) + . 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) - <*> (spaces *> allDouble) + <$> (char 'v' *> many' space *> double) + <*> (many' space *> double) parseFace :: Parser [Integer] -parseFace = char 'f' *> oneOrMore (spaces *> posInt) +parseFace = char 'f' *> many1' (many' space *> decimal) diff --git a/Parser/PathParser.hs b/Parser/PathParser.hs index ed343ed..a56922c 100644 --- a/Parser/PathParser.hs +++ b/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 - Nothing -> [] - Just xs -> fst xs +stringToQuads str = case parseOnly parsePath (B.pack str) of + Left _ -> [] + Right xs -> xs where - parsePath = zeroOrMore ((parseQuad <|> parseOrient) - <* zeroOrMore (char ',') - <* spaces) + parsePath = many' ((parseQuad <|> parseOrient) + <* many' (char ',') + <* 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 NE) <$> (string "ne" <|> string "NE") - <|> const (Left SW) <$> (string "sw" <|> string "SW") - <|> const (Left SE) <$> (string "se" <|> string "SE") + const (Left NW) <$> (string (B.pack "nw") <|> string (B.pack "NW")) + <|> const (Left NE) <$> (string (B.pack "ne") <|> string (B.pack "NE")) + <|> const (Left SW) <$> (string (B.pack "sw") <|> string (B.pack "SW")) + <|> 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 South) <$> (string "s" <|> string "S") - <|> const (Right West) <$> (string "w" <|> string "W") - <|> const (Right East) <$> (string "e" <|> string "E") + const (Right North) <$> (string (B.pack "n") <|> string (B.pack "N")) + <|> const (Right South) <$> (string (B.pack "s") <|> string (B.pack "S")) + <|> const (Right West) <$> (string (B.pack "w") <|> string (B.pack "W")) + <|> const (Right East) <$> (string (B.pack "e") <|> string (B.pack "E"))