From a782b615278a77f4a237d7864ebef3d86518c7a3 Mon Sep 17 00:00:00 2001
From: Zoe Roux <zoe.roux@sdg.moe>
Date: Wed, 10 Mar 2021 19:16:07 +0100
Subject: [PATCH] Basic parsing now works!

---
 .gitignore        |  5 ++++-
 GetOpt.hs         | 34 +++++++++++++++++++++++-----------
 GetOpt/Data.hs    | 13 +++++--------
 GetOpt/Options.hs | 15 +++++++++------
 GetOpt/Parsers.hs | 13 ++++++++++++-
 Main.hs           | 37 +++++++++++++++++++++++++++++++++++++
 6 files changed, 90 insertions(+), 27 deletions(-)
 create mode 100644 Main.hs

diff --git a/.gitignore b/.gitignore
index 6508432..1df1836 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,7 @@
 .stack-work/
 *~
 .idea/
-wolfram
+.vscode/
+**/*.hi
+**/*.o
+Main
\ No newline at end of file
diff --git a/GetOpt.hs b/GetOpt.hs
index c9da916..f063ff1 100644
--- a/GetOpt.hs
+++ b/GetOpt.hs
@@ -1,5 +1,15 @@
 {-# LANGUAGE GADTs #-}
-module GetOpt where
+module GetOpt (
+    getOpt,
+    GetOpt.Parsers.Parser(..),
+    GetOpt.Options.help,
+    GetOpt.Options.long,
+    GetOpt.Options.short,
+    GetOpt.Options.value,
+    GetOpt.Options.meta,
+    GetOpt.Options.option,
+    GetOpt.Options.auto,
+) where
 
 import GetOpt.Data
 import GetOpt.Options
@@ -10,13 +20,15 @@ getOpt (DefParser a) args = Just (a, args)
 getOpt p args = case runParser p args of
                      Just (p1, args1) -> getOpt p1 args1
                      Nothing          -> Nothing
-    where
-        runParser :: Parser a -> [String] -> Maybe (Parser a, [String])
-        runParser (OptParser opt next) (identifier:arg:args)
-            | optionMatch opt identifier = do
-                ret <- parser opt arg
-                return (fmap ret next, args)
-            | otherwise                  = do
-                (nextP, newArgs) <- runParser next (identifier:args)
-                return (OptParser opt nextP, newArgs)
-        runParser p@(DefParser _) args = Just (p, args)
\ No newline at end of file
+
+runParser :: Parser a -> [String] -> Maybe (Parser a, [String])
+runParser p@(DefParser _) args = Just (p, args)
+runParser (OptParser _ _) [] = Nothing
+runParser (OptParser _ _) [_] = Nothing -- TODO remove this and support default values
+runParser (OptParser opt next) (identifier:arg:args)
+    | optionMatch opt identifier = do
+        ret <- parser opt arg
+        return (fmap ret next, args)
+    | otherwise                  = do
+        (nextP, newArgs) <- runParser next (identifier:args)
+        return (OptParser opt nextP, newArgs)
\ No newline at end of file
diff --git a/GetOpt/Data.hs b/GetOpt/Data.hs
index 858f986..0d45b6f 100644
--- a/GetOpt/Data.hs
+++ b/GetOpt/Data.hs
@@ -1,15 +1,8 @@
-{-# LANGUAGE GADTs #-}
 module GetOpt.Data (
-    Parser(DefParser, OptParser),
     OptionParser,
     Option(..)
 ) where
 
-
-data Parser a where 
-    DefParser :: a -> Parser a
-    OptParser :: Option (a -> b) -> Parser a -> Parser b
-
 type OptionParser a = (String -> Maybe a)
 
 data Option a = Option {
@@ -19,4 +12,8 @@ data Option a = Option {
     defaultValue :: Maybe a,
     helpMessage :: String,
     parser :: OptionParser a
-}
\ No newline at end of file
+}
+
+instance Functor Option where
+    -- fmap :: (a -> b) -> f a -> f b
+    fmap f (Option mv l s dv hm p) = Option mv l s (fmap f dv) hm (fmap f . p)
\ No newline at end of file
diff --git a/GetOpt/Options.hs b/GetOpt/Options.hs
index 737a03f..c4241a1 100644
--- a/GetOpt/Options.hs
+++ b/GetOpt/Options.hs
@@ -1,10 +1,7 @@
 module GetOpt.Options where
 
-import GetOpt.Data(Option(..), OptionParser, Parser(..))
-
-instance Functor Option where
-    -- fmap :: (a -> b) -> f a -> f b
-    fmap f (Option mv l s dv hm p) = Option mv l s (fmap f dv) hm (fmap f . p)
+import GetOpt.Data(Option(..), OptionParser)
+import GetOpt.Parsers
 
 meta :: String -> Mod a
 meta v = Mod $ \x -> x { metavar = v }
@@ -35,4 +32,10 @@ option p (Mod m) = OptParser (fmap const (m $ def p)) (DefParser ())
 
 optionMatch :: Option a -> String -> Bool
 optionMatch opt [d, s] = d == '-' && s == shortName opt
-optionMatch opt (d:d1:l) = d == '-' && d1 ==  '-' && l == longName opt
\ No newline at end of file
+optionMatch opt (d:d1:l) = d == '-' && d1 ==  '-' && l == longName opt
+optionMatch _ _ = False
+
+auto :: Read a => OptionParser a
+auto str = case reads str of
+                [(v, "")] -> Just v
+                _         -> Nothing
\ No newline at end of file
diff --git a/GetOpt/Parsers.hs b/GetOpt/Parsers.hs
index 0e73aa8..d49d0da 100644
--- a/GetOpt/Parsers.hs
+++ b/GetOpt/Parsers.hs
@@ -1,3 +1,14 @@
+{-# LANGUAGE GADTs #-}
 module GetOpt.Parsers where
 
-import GetOpt.Data
\ No newline at end of file
+import GetOpt.Data (Option(..))
+
+data Parser a where
+    DefParser :: a -> Parser a
+    OptParser :: Option (a -> b) -> Parser a -> Parser b
+
+instance Functor Parser where
+    -- fmap (a -> b) -> f a -> f b
+    fmap f (DefParser a) = DefParser $ f a
+    fmap f (OptParser opt next) = OptParser (fmap (f .) opt) next
+
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..590177e
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,37 @@
+module Main where
+
+import GetOpt
+import System.Environment (getArgs)
+
+main :: IO()
+main = do
+    args <- getArgs
+    print $ getOpt getParser args
+
+
+getParser :: Parser Configuration
+getParser = Configuration
+         <$> option auto (
+               long "rule"
+            <> short 'r'
+            <> meta "RULE"
+            <> help "The rulset used." 
+         )
+        --  <*> option (
+        --        long "start"
+        --     <> short 's'
+        --     <> meta "START"
+        --     <> help "At witch line should we start"
+        --     <> value 0
+        --  )
+
+
+
+data Configuration = Configuration {
+    rule :: Int 
+    -- start :: Int,
+    -- lines :: Maybe Int,
+    -- window :: Int,
+    -- move :: Int
+} deriving Show
+