From b9c8207981d8da98c47e2db635945dc3f6495e66 Mon Sep 17 00:00:00 2001
From: hasufell <hasufell@hasufell.de>
Date: Fri, 14 Nov 2014 21:23:43 +0100
Subject: [PATCH] Add PathParser

This allows us to parser user input in order to traverse
the QuadTree from the Algorithms.RangeSearch module.
---
 Parser/PathParser.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 Parser/PathParser.hs

diff --git a/Parser/PathParser.hs b/Parser/PathParser.hs
new file mode 100644
index 0000000..f844653
--- /dev/null
+++ b/Parser/PathParser.hs
@@ -0,0 +1,46 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+module Parser.PathParser where
+
+import Control.Applicative
+import Parser.Core
+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
+-- [Quad NE, Orient North, Quad SW, Orient East].
+stringToQuads :: String -> [QuadOrOrient]
+stringToQuads str = case runParser parsePath str of
+  Nothing -> []
+  Just xs -> fst xs
+  where
+    parsePath = zeroOrMore ((parseQuad <|> parseOrient)
+                             <* zeroOrMore (char ',')
+                             <* spaces)
+
+
+-- |Parses a string that represents a single squad into the
+-- QuadOrOrient ADT.
+parseQuad :: Parser QuadOrOrient
+parseQuad =
+  const (Quad NW) <$> (string "nw" <|> string "NW")
+    <|> const (Quad NE) <$> (string "ne" <|> string "NE")
+    <|> const (Quad SW) <$> (string "sw" <|> string "SW")
+    <|> const (Quad SE) <$> (string "se" <|> string "SE")
+
+
+-- |Parses a string that represents a single Orientation into the
+-- QuadOrOrient ADT.
+parseOrient :: Parser QuadOrOrient
+parseOrient =
+  const (Orient North) <$> (string "n" <|> string "N")
+    <|> const (Orient South) <$> (string "s" <|> string "S")
+    <|> const (Orient West) <$> (string "w" <|> string "W")
+    <|> const (Orient East) <$> (string "e" <|> string "E")