hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

PARSER: use 'Either' from Prelude instead of custom QuadOrOrient

Browse Source
This commit is contained in:
hasufell 2014-11-14 22:58:21 +01:00
parent 068ea04d56
commit d5741d3839
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 19 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Graphics/Diagram/Plotter.hs
View File

@ -197,11 +197,11 @@ quadPathSquare = Diag f
# moveTo (p2 ((xmax + xmin) / 2,(ymax + ymin) / 2)) # lw thin # lc red) # moveTo (p2 ((xmax + xmin) / 2,(ymax + ymin) / 2)) # lw thin # lc red)
(getSquare (stringToQuads (pQt p)) (qt, [])) (getSquare (stringToQuads (pQt p)) (qt, []))
where where
getSquare :: [QuadOrOrient] -> Zipper PT -> Square getSquare :: [Either Quad Orient] -> Zipper PT -> Square
getSquare [] z = getSquareByZipper (dX p, dY p) z getSquare [] z = getSquareByZipper (dX p, dY p) z
getSquare (q:qs) z = case q of getSquare (q:qs) z = case q of
Orient x -> getSquare qs (fromMaybe z (findNeighbor x z)) Right x -> getSquare qs (fromMaybe z (findNeighbor x z))
Quad x -> getSquare qs (fromMaybe z (goQuad x z)) Left x -> getSquare qs (fromMaybe z (goQuad x z))
qt :: QuadTree PT qt :: QuadTree PT
qt = quadTree vtf (dX p, dY p) qt = quadTree vtf (dX p, dY p)
vtf :: [PT] vtf :: [PT]
@ -218,12 +218,12 @@ gifQuadPath = GifDiag f
# moveTo (p2 ((xmax + xmin) / 2,(ymax + ymin) / 2)) # lw thick # lc col) # moveTo (p2 ((xmax + xmin) / 2,(ymax + ymin) / 2)) # lw thick # lc col)
<$> (getSquares (stringToQuads (pQt p)) (qt, [])) <$> (getSquares (stringToQuads (pQt p)) (qt, []))
where where
getSquares :: [QuadOrOrient] -> Zipper PT -> [Square] getSquares :: [Either Quad Orient] -> Zipper PT -> [Square]
getSquares [] z = [getSquareByZipper (dX p, dY p) z] getSquares [] z = [getSquareByZipper (dX p, dY p) z]
getSquares (q:qs) z = case q of getSquares (q:qs) z = case q of
Orient x -> getSquareByZipper (dX p, dY p) z : Right x -> getSquareByZipper (dX p, dY p) z :
getSquares qs (fromMaybe z (findNeighbor x z)) getSquares qs (fromMaybe z (findNeighbor x z))
Quad x -> getSquareByZipper (dX p, dY p) z : Left x -> getSquareByZipper (dX p, dY p) z :
getSquares qs (fromMaybe z (goQuad x z)) getSquares qs (fromMaybe z (goQuad x z))
qt :: QuadTree PT qt :: QuadTree PT
qt = quadTree vtf (dX p, dY p) qt = quadTree vtf (dX p, dY p)

29
Parser/PathParser.hs
View File

@ -7,16 +7,9 @@ import Parser.Core
import Algorithms.RangeSearch.Core (Quad(NW, NE, SW, SE), Orient(North, South, West, East)) import Algorithms.RangeSearch.Core (Quad(NW, NE, SW, SE), Orient(North, South, West, East))
-- |Can either be an Orientation or a Quad, corresponding to the
-- Algorithms.RangeSearch module.
data QuadOrOrient = Orient Orient
| Quad Quad
deriving (Show)
-- |Parse a string such as "ne, n, sw, e" into -- |Parse a string such as "ne, n, sw, e" into
-- [Quad NE, Orient North, Quad SW, Orient East]. -- [Quad NE, Orient North, Quad SW, Orient East].
stringToQuads :: String -> [QuadOrOrient] stringToQuads :: String -> [Either Quad Orient]
stringToQuads str = case runParser parsePath str of stringToQuads str = case runParser parsePath str of
Nothing -> [] Nothing -> []
Just xs -> fst xs Just xs -> fst xs
@ -28,19 +21,19 @@ stringToQuads str = case runParser parsePath str of
-- |Parses a string that represents a single squad into the -- |Parses a string that represents a single squad into the
-- QuadOrOrient ADT. -- QuadOrOrient ADT.
parseQuad :: Parser QuadOrOrient parseQuad :: Parser (Either Quad Orient)
parseQuad = parseQuad =
const (Quad NW) <$> (string "nw" <|> string "NW") const (Left NW) <$> (string "nw" <|> string "NW")
<|> const (Quad NE) <$> (string "ne" <|> string "NE") <|> const (Left NE) <$> (string "ne" <|> string "NE")
<|> const (Quad SW) <$> (string "sw" <|> string "SW") <|> const (Left SW) <$> (string "sw" <|> string "SW")
<|> const (Quad SE) <$> (string "se" <|> string "SE") <|> const (Left SE) <$> (string "se" <|> string "SE")
-- |Parses a string that represents a single Orientation into the -- |Parses a string that represents a single Orientation into the
-- QuadOrOrient ADT. -- QuadOrOrient ADT.
parseOrient :: Parser QuadOrOrient parseOrient :: Parser (Either Quad Orient)
parseOrient = parseOrient =
const (Orient North) <$> (string "n" <|> string "N") const (Right North) <$> (string "n" <|> string "N")
<|> const (Orient South) <$> (string "s" <|> string "S") <|> const (Right South) <$> (string "s" <|> string "S")
<|> const (Orient West) <$> (string "w" <|> string "W") <|> const (Right West) <$> (string "w" <|> string "W")
<|> const (Orient East) <$> (string "e" <|> string "E") <|> const (Right East) <$> (string "e" <|> string "E")