From ce9515ad7a00e42dfd28a42a947fb7fc18379e66 Mon Sep 17 00:00:00 2001
From: Corey O'Connor <coreyoconnor@gmail.com>
Date: Fri, 18 Apr 2014 21:44:02 -0700
Subject: [PATCH] implement config parsing

---
 src/Data/Terminfo/Parse.hs |  2 +-
 src/Graphics/Vty/Config.hs | 25 ++++++++++++++++++++++++-
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/src/Data/Terminfo/Parse.hs b/src/Data/Terminfo/Parse.hs
index db5b7c7..9904e53 100644
--- a/src/Data/Terminfo/Parse.hs
+++ b/src/Data/Terminfo/Parse.hs
@@ -16,7 +16,7 @@ import qualified Data.Vector.Unboxed as Vector
 
 import Numeric (showHex)
 
-import Text.ParserCombinators.Parsec
+import Text.Parsec
 
 data CapExpression = CapExpression
     { capOps :: !CapOps
diff --git a/src/Graphics/Vty/Config.hs b/src/Graphics/Vty/Config.hs
index 4420e73..3f8a0ce 100644
--- a/src/Graphics/Vty/Config.hs
+++ b/src/Graphics/Vty/Config.hs
@@ -7,11 +7,17 @@
 module Graphics.Vty.Config where
 
 import Data.Default
+import Data.Either (either)
+import Data.Monoid
 
 import Graphics.Vty.Input.Events
 
 import System.FilePath
 
+import Text.Parsec
+import qualified Text.Parsec.Token as P
+import Text.Parsec.Language (haskellDef)
+
 data Config = Config
     { singleEscPeriod   :: Int            -- ^ AKA VTIME. The default is 100000 microseconds or 0.1 seconds.
     -- | Debug information about the input process is appended to the file.
@@ -26,5 +32,22 @@ instance Default Config where
         , inputOverrides = []
         }
 
+-- not a proper monoid but useful as one.
+instance Monoid Config where
+    mempty = def
+    mappend c0 c1 = c1 { inputOverrides = inputOverrides c0 <> inputOverrides c1 }
+
 parseConfigFile :: FilePath -> IO Config
-parseConfigFile path = return def
+parseConfigFile path = either (const def) id <$> parseFromFile parseConfig path
+
+parseConfig = do
+    let lexer = P.makeTokenParser haskellDef
+        parseOverride = do
+            P.whiteSpace lexer
+            string "map"
+            P.whiteSpace lexer
+            bytes <- P.stringLiteral
+            key <- parseKey
+            modifier <- parseModifier
+            _ <- manyTill space newline
+    overrides <- many $ try parseOverride <|> ignoreOverride