Adding a foo getopt to run the project

app/Main.hs

@@ -1,5 +1,7 @@
 module Main where
 
+import System.Environment (getArgs)
+import Text.Read
 import System.Exit (exitWith, ExitCode (ExitFailure))
 --import MyGetOpt
 
@@ -64,9 +66,11 @@ printCells config (x:xs) = pl x >> printCells config xs
         toChar Full = '*'
 
 main :: IO ()
-main = case getConfig of 
-            Nothing -> exitWith (ExitFailure 84)
-            Just config -> printCells config (post config . generate $ rule config)
+main = do
+    args <- getArgs
+    case getOpt args defaultConfiguration of 
+         (Just config) -> printCells config (post config . generate $ rule config)
+         Nothing       -> exitWith (ExitFailure 84)
     where
         post :: Configuration -> [CellList] -> [CellList]
         post config = drop (start config)
@@ -95,8 +99,14 @@ main = case getConfig of
             |  otherwise = zipWith const (drop n (cycle xs)) xs
 
 
-getConfig :: Maybe Configuration
-getConfig = Just $ Configuration 90 0 (Just 20) 80 0
+getOpt :: [String] -> Configuration -> Maybe Configuration
+getOpt [] conf = Just conf
+getOpt ("--rule":x:xs) c = readMaybe x >>= \arg -> getOpt xs c{ rule = arg }
+getOpt ("--start":x:xs) c = readMaybe x >>= \arg -> getOpt xs c{ start = arg }
+getOpt ("--lines":x:xs) c = readMaybe x >>= \arg -> getOpt xs c{ Main.lines = Just arg }
+getOpt ("--window":x:xs) c = readMaybe x >>= \arg -> getOpt xs c{ window = arg }
+getOpt ("--move":x:xs) c = readMaybe x >>= \arg -> getOpt xs c{ move = arg }
+getOpt _ _ = Nothing
 
 
 data Configuration = Configuration {
@@ -107,20 +117,12 @@ data Configuration = Configuration {
     move :: Int
 } deriving Show
 
---config :: Parser Configuration
---config = Configuration
---    <$> option
---        (  long "rule"
---        <> short "r"
---        <> metavar "RULE"
---        <> help "The rulset used."
---        )
 
-
---defaultConfiguration = Configuration {
---    rule = 0,
---    start = Just 0,
---    Main.lines = Nothing,
---    window = Just 80,
---    move = Just 0
---}
+defaultConfiguration :: Configuration
+defaultConfiguration = Configuration {
+   rule = 0,
+   start = 0,
+   Main.lines = Nothing,
+   window = 80,
+   move = 0
+}

src/MyGetOpt.hs

@@ -1,129 +1,141 @@
+{-# LANGUAGE LambdaCase #-}
 module MyGetOpt where
 
-import Control.Applicative
-import Data.Char
+-- import Control.Applicative ( Alternative(..) )
+-- import Data.Char ( isSpace, isDigit, isAlphaNum )
 
-newtype Parser a = Parser { parse :: String -> Maybe (a, String) }
+-- data Parser a where 
+--     Parser :: String -> Maybe (a, String)
+--     OptParser :: Option (a -> b) -> Parser a -> Parser b
 
-instance Functor Parser where
-    -- fmap :: (a -> b) -> f a -> f b
-    fmap f p = Parser $ \x -> case parse p x of
-                                   Nothing -> Nothing
-                                   Just (y, lo) -> Just (f y, lo)
+-- instance Functor Parser where
+--     -- fmap :: (a -> b) -> f a -> f b
+--     fmap f p@(Parser _) = Parser $ \str -> do
+--         (v, lo) <- p str
+--         return (f v, lo)
+--     fmap f (OptParser opt p) = OptParser opt (fmap f p)
 
-instance Applicative Parser where
-    -- pure :: a -> f a
-    pure x = Parser (\lo -> Just (x, lo))
+-- instance Applicative Parser where
+--     -- pure :: a -> f a
+--     pure x = Parser (\lo -> Just (x, lo))
 
-    -- (<*>) :: f (a -> b) -> f a -> f b
-    (<*>) (Parser f) (Parser p) = Parser $ \str -> do
-        (f, lo) <- f str
-        (v, lo1) <- p lo
-        return (f v, lo1)
+--     -- (<*>) :: f (a -> b) -> f a -> f b
+--     (<*>) (Parser f) p = fmap f p
+--     (<*>) (OptParser opt f) p = OptParser
 
-instance Monad Parser where
-    -- (>>=) :: forall a b. m a -> (a -> m b) -> m b
-    (>>=) p f = Parser $ \str -> case parse p str of
-                                      Nothing -> Nothing
-                                      Just (y, lo) -> parse (f y) lo
+-- instance Monad Parser where
+--     -- (>>=) :: forall a b. m a -> (a -> m b) -> m b
+--     (>>=) p f = Parser $ \str -> case parse p str of
+--                                       Nothing -> Nothing
+--                                       Just (y, lo) -> parse (f y) lo
 
-instance Alternative Parser where
-    -- empty :: f a
-    empty = Parser $ const Nothing
+-- instance Alternative Parser where
+--     -- empty :: f a
+--     empty = Parser $ const Nothing
 
-    -- (<|>) :: f a -> f a -> f a
-    (<|>) a b = Parser $ \x -> case parse a x of
-                                    Nothing -> parse b x
-                                    y -> y
+--     -- (<|>) :: f a -> f a -> f a
+--     (<|>) a b = Parser $ \x -> case parse a x of
+--                                     Nothing -> parse b x
+--                                     y -> y
 
 
-char :: Parser Char
-char = Parser $ \x -> case x of
-                           [] -> Nothing
-                           (x:xs) -> Just (x, xs)
+-- char :: Parser Char
+-- char = Parser $ \case
+--                     []     -> Nothing
+--                     (x:xs) -> Just (x, xs)
 
-charIf :: (Char -> Bool) -> Parser Char
-charIf f = do
-    x <- char
-    if f x then return x else empty
+-- charIf :: (Char -> Bool) -> Parser Char
+-- charIf f = do
+--     x <- char
+--     if f x then return x else empty
 
-alphaNum :: Parser Char
-alphaNum = charIf isAlphaNum
+-- alphaNum :: Parser Char
+-- alphaNum = charIf isAlphaNum
 
-digit :: Parser Char
-digit = charIf isDigit
+-- digit :: Parser Char
+-- digit = charIf isDigit
 
-num :: Parser Int
-num = do
-    x <- some digit
-    return $ read x
+-- num :: Parser Int
+-- num = do
+--     x <- some digit
+--     return $ read x
 
-int :: Parser Int
-int =
-    do
-        charIf $ \x -> x == '-'
-        x <- num
-        return (-x)
-    <|>
-        num
+-- int :: Parser Int
+-- int =
+--     do
+--         charIf $ \x -> x == '-'
+--         x <- num
+--         return (-x)
+--     <|>
+--         num
 
-maybeInt :: Parser (Maybe Int)
-maybeInt = Parser $ \str -> case parse int str of
-                                 Nothing -> Just (Nothing, str)
-                                 Just (y, lo)  -> Just (Just y, lo)
+-- maybeInt :: Parser (Maybe Int)
+-- maybeInt = Parser $ \str -> case parse int str of
+--                                  Nothing -> Just (Nothing, str)
+--                                  Just (y, lo)  -> Just (Just y, lo)
 
-token :: Parser a -> Parser a
-token p = do
-    many $ charIf isSpace
-    ret <- p
-    many $ charIf isSpace
-    return ret
+-- token :: Parser a -> Parser a
+-- token p = do
+--     many $ charIf isSpace
+--     ret <- p
+--     many $ charIf isSpace
+--     return ret
 
 
-data Option a = Option {
-    metavar :: String,
-    longName :: String,
-    shortName :: Char,
-    defaultValue :: Maybe a,
-    helpMessage :: String,
-    parser :: Parser a
-}
+-- 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 }
+-- meta :: String -> Mod a
+-- meta v = Mod $ \x -> x { metavar = v }
 
-long :: String -> Mod a
-long v = Mod $ \x -> x { longName = v }
+-- long :: String -> Mod a
+-- long v = Mod $ \x -> x { longName = v }
 
-short :: Char -> Mod a
-short v = Mod $ \x -> x { shortName = v }
+-- short :: Char -> Mod a
+-- short v = Mod $ \x -> x { shortName = v }
 
-value :: a -> Mod a
-value v = Mod $ \x -> x { defaultValue = Just v }
+-- value :: a -> Mod a
+-- value v = Mod $ \x -> x { defaultValue = Just v }
 
-help :: String -> Mod a
-help v = Mod $ \x -> x { helpMessage = v }
+-- help :: String -> Mod a
+-- help v = Mod $ \x -> x { helpMessage = v }
 
 
-newtype Mod a = Mod (Option a -> Option a)
+-- newtype Mod a = Mod (Option a -> Option a)
 
-instance Semigroup (Mod a) where
-    -- (<>) a -> a -> a
-    (<>) (Mod a) (Mod b) = Mod (a . b)
+-- instance Semigroup (Mod a) where
+--     -- (<>) a -> a -> a
+--     (<>) (Mod a) (Mod b) = Mod (a . b)
 
----- If need to compile, comment everything bellow.
---option :: Parser Int -> Mod Int -> Parser a
---option p (Mod m) = optionParser (m $ def p)
+-- option :: Parser a -> Mod a -> Parser a
+-- option p (Mod m) = OptParser (m $ def p)
 --    where
 --        def = Option "VAR" "" ' ' Nothing "No help message set."
---
---optionParser :: Option a -> Parser a
---optionParser _ []
---
---
----- 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/
---
---runParser :: Parser a -> [String] -> Maybe (a, [String])
---runParser ::
+
+-- -- 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/
+
+-- runParser :: Parser a -> [String] -> Maybe (a, [String])
+-- runParser (OptParser opt nextp) (o:xs)
+--     | optionMatch opt o = runOption opt xs
+--     | otherwise         = runParser (OptParser opt NEXTPARSER) (runParser nextp o:xs)
+
+--     where
+--         optionMatch :: Option a -> String -> Bool
+--         optionMatch opt [d, s] = d == '-' && s == shortName opt
+--         optionMatch opt (d:d1:l) = d == '-' && d1 ==  '-' && l == longName opt
+
+--         runOption :: Option a -> [String] -> Maybe (a, [String])
+--         runOption opt (value:args) = case parse opt value of
+--                                           Just (out, []) -> Just (out, args)
+--                                           _              -> Nothing
+
+--         skipOption :: Option a -> Parser b -> [String] -> Maybe (a, [String])
+--         skipOption skipped nextP args