PARSER: use attoparsec instead of our own implementation
This also uses ByteStringS and might be faster.
This commit is contained in:
parent
7527e0bec3
commit
2be25ae27c
10
CG2.cabal
10
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,
|
||||
|
||||
145
Parser/Core.hs
145
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)
|
||||
@ -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)
|
||||
|
||||
@ -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"))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user