Recreating a parser

GetOpt.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE GADTs #-}
+module GetOpt where
+
+import GetOpt.Data
+import GetOpt.Options
+import GetOpt.Parsers

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
+}

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."

GetOpt/Parsers.hs

@@ -0,0 +1,3 @@
+module GetOpt.Parsers where
+
+import GetOpt.Data

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/