From cca9d9bd4f3a8d832a8cf9d44488da436db8aba7 Mon Sep 17 00:00:00 2001
From: Zoe Roux <zoe.roux@sdg.moe>
Date: Wed, 10 Mar 2021 16:02:01 +0100
Subject: [PATCH] Recreating a parser

---
 GetOpt.hs             |  6 ++++++
 GetOpt/Data.hs        | 24 ++++++++++++++++++++++++
 GetOpt/Options.hs     | 34 ++++++++++++++++++++++++++++++++++
 GetOpt/Parsers.hs     |  3 +++
 MyGetOpt.hs => Old.hs | 39 +--------------------------------------
 5 files changed, 68 insertions(+), 38 deletions(-)
 create mode 100644 GetOpt.hs
 create mode 100644 GetOpt/Data.hs
 create mode 100644 GetOpt/Options.hs
 create mode 100644 GetOpt/Parsers.hs
 rename MyGetOpt.hs => Old.hs (79%)

diff --git a/GetOpt.hs b/GetOpt.hs
new file mode 100644
index 0000000..f4a89ba
--- /dev/null
+++ b/GetOpt.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE GADTs #-}
+module GetOpt where
+
+import GetOpt.Data
+import GetOpt.Options
+import GetOpt.Parsers
\ No newline at end of file
diff --git a/GetOpt/Data.hs b/GetOpt/Data.hs
new file mode 100644
index 0000000..23ed1b1
--- /dev/null
+++ b/GetOpt/Data.hs
@@ -0,0 +1,24 @@
+{-# 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
+
+-- newtype OptionParser a = OptionParser { parse :: String -> Maybe a }
+
+type OptionParser a = (String -> Maybe a)
+
+data Option a = Option {
+    metavar :: String,
+    longName :: String,
+    shortName :: Char,
+    defaultValue :: Maybe a,
+    helpMessage :: String,
+    parser :: OptionParser a
+}
\ No newline at end of file
diff --git a/GetOpt/Options.hs b/GetOpt/Options.hs
new file mode 100644
index 0000000..373262c
--- /dev/null
+++ b/GetOpt/Options.hs
@@ -0,0 +1,34 @@
+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)
+
+meta :: String -> Mod a
+meta v = Mod $ \x -> x { metavar = v }
+
+long :: String -> Mod a
+long v = Mod $ \x -> x { longName = v }
+
+short :: Char -> Mod a
+short v = Mod $ \x -> x { shortName = v }
+
+value :: a -> Mod a
+value v = Mod $ \x -> x { defaultValue = Just v }
+
+help :: String -> Mod a
+help v = Mod $ \x -> x { helpMessage = v }
+
+
+newtype Mod a = Mod (Option a -> Option a)
+
+instance Semigroup (Mod a) where
+    -- (<>) a -> a -> a
+    (<>) (Mod a) (Mod b) = Mod (a . b)
+
+option :: OptionParser a -> Mod a -> Parser a
+option p (Mod m) = OptParser (fmap const (m $ def p)) (DefParser ())
+   where
+       def = Option "VAR" "" ' ' Nothing "No help message set."
\ No newline at end of file
diff --git a/GetOpt/Parsers.hs b/GetOpt/Parsers.hs
new file mode 100644
index 0000000..0e73aa8
--- /dev/null
+++ b/GetOpt/Parsers.hs
@@ -0,0 +1,3 @@
+module GetOpt.Parsers where
+
+import GetOpt.Data
\ No newline at end of file
diff --git a/MyGetOpt.hs b/Old.hs
similarity index 79%
rename from MyGetOpt.hs
rename to Old.hs
index ade9c39..36d337c 100644
--- a/MyGetOpt.hs
+++ b/Old.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-module MyGetOpt where
+module OldGetOpt where
 
 import Control.Applicative ( Alternative(..) )
 import Data.Char ( isSpace, isDigit, isAlphaNum )
@@ -81,43 +81,6 @@ token p = do
     many $ charIf isSpace
     return ret
 
-
-data Option a = Option {
-    metavar :: String,
-    longName :: String,
-    shortName :: Char,
-    defaultValue :: Maybe a,
-    helpMessage :: String,
-    parser :: Parser a
-}
-
-meta :: String -> Mod a
-meta v = Mod $ \x -> x { metavar = v }
-
-long :: String -> Mod a
-long v = Mod $ \x -> x { longName = v }
-
-short :: Char -> Mod a
-short v = Mod $ \x -> x { shortName = v }
-
-value :: a -> Mod a
-value v = Mod $ \x -> x { defaultValue = Just v }
-
-help :: String -> Mod a
-help v = Mod $ \x -> x { helpMessage = v }
-
-
-newtype Mod a = Mod (Option a -> Option a)
-
-instance Semigroup (Mod a) where
-    -- (<>) a -> a -> a
-    (<>) (Mod a) (Mod b) = Mod (a . b)
-
-option :: Parser a -> Mod a -> Parser a
-option p (Mod m) = OptParser (m $ def p)
-   where
-       def = Option "VAR" "" ' ' Nothing "No help message set."
-
 -- TODO Create a type OptionParser witch contains the short & long names & n args parsers.
 -- TODO Pattern match for the OptionParser or a default parser in the runParser. Option parser will check named args while the default one will do positional ones.
 -- EXAMPLE: https://www.paolocapriotti.com/blog/2012/04/27/applicative-option-parser/