2014-11-14 20:23:43 +00:00
|
|
|
{-# OPTIONS_HADDOCK ignore-exports #-}
|
|
|
|
|
|
|
|
module Parser.PathParser where
|
|
|
|
|
2014-12-03 20:26:35 +00:00
|
|
|
import Algorithms.QuadTree (Quad(NW, NE, SW, SE), Orient(North, South, West, East))
|
2014-11-21 03:30:50 +00:00
|
|
|
import Control.Applicative
|
|
|
|
import Data.Attoparsec.ByteString.Char8
|
|
|
|
import qualified Data.ByteString.Char8 as B
|
2014-11-14 20:23:43 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Parse a string such as "ne, n, sw, e" into
|
|
|
|
-- [Quad NE, Orient North, Quad SW, Orient East].
|
2014-11-14 21:58:21 +00:00
|
|
|
stringToQuads :: String -> [Either Quad Orient]
|
2014-11-21 03:30:50 +00:00
|
|
|
stringToQuads str = case parseOnly parsePath (B.pack str) of
|
|
|
|
Left _ -> []
|
|
|
|
Right xs -> xs
|
2014-11-14 20:23:43 +00:00
|
|
|
where
|
2014-11-21 03:30:50 +00:00
|
|
|
parsePath = many' ((parseQuad <|> parseOrient)
|
|
|
|
<* many' (char ',')
|
|
|
|
<* many' space)
|
2014-11-14 20:23:43 +00:00
|
|
|
|
|
|
|
|
2014-11-21 03:36:07 +00:00
|
|
|
-- |Parses a string that represents a single quad.
|
2014-11-14 21:58:21 +00:00
|
|
|
parseQuad :: Parser (Either Quad Orient)
|
2014-11-14 20:23:43 +00:00
|
|
|
parseQuad =
|
2014-11-21 03:30:50 +00:00
|
|
|
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"))
|
2014-11-14 20:23:43 +00:00
|
|
|
|
|
|
|
|
2014-11-21 03:36:07 +00:00
|
|
|
-- |Parses a string that represents a single Orientation.
|
2014-11-14 21:58:21 +00:00
|
|
|
parseOrient :: Parser (Either Quad Orient)
|
2014-11-14 20:23:43 +00:00
|
|
|
parseOrient =
|
2014-11-21 03:30:50 +00:00
|
|
|
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"))
|