diff --git a/app/Main.hs b/app/Main.hs index 5e17f48..52ca31a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,9 +1,15 @@ module Main where import Lib +import MyGetOpt main :: IO () -main = someFunc +main = print option + ( long "rule" + <> short "r" + <> metavar "RULE" + <> help "The rulset used." + ) data Configuration = Configuration { @@ -14,14 +20,14 @@ data Configuration = Configuration { move :: Maybe Int } deriving Show -config :: Parser Configuration -config :: Config - <$> option - ( long "rule" - <> short "r" - <> metavar "RULE" - <> help "The rulset used." - ) +--config :: Parser Configuration +--config = Configuration +-- <$> option +-- ( long "rule" +-- <> short "r" +-- <> metavar "RULE" +-- <> help "The rulset used." +-- ) --defaultConfiguration = Configuration { diff --git a/app/MyGetOpt.hs b/app/MyGetOpt.hs deleted file mode 100644 index 05ab6fd..0000000 --- a/app/MyGetOpt.hs +++ /dev/null @@ -1,96 +0,0 @@ -import Control.Applicative -import Data.Char - -newtype Parser a = P { parse :: (String -> Maybe (a, String)) } - -instance Functor Parser where - -- fmap :: (a -> b) -> f a -> f b - fmap f p = P $ \x -> case parse p x of - Nothing -> Nothing - Just (y, lo) -> Just (f y, lo) - -instance Applicative Parser where - -- pure :: a -> f a - pure x = P (\lo -> Just (x, lo)) - - -- (<*>) :: f (a -> b) -> f a -> f b - (<*>) (P f) (P p) = P $ \str -> do - (f, lo) <- f str - (v, lo1) <- p lo - return (f v, lo1) - -instance Monad Parser where - -- (>>=) :: forall a b. m a -> (a -> m b) -> m b - (>>=) p f = P $ \str -> case parse p str of - Nothing -> Nothing - Just (y, lo) -> parse (f y) lo - -instance Alternative Parser where - -- empty :: f a - empty = P (\_ -> Nothing) - - -- (<|>) :: f a -> f a -> f a - (<|>) a b = P $ \x -> case parse a x of - Nothing -> parse b x - y -> y - - -char :: Parser Char -char = P $ \x -> case x of - [] -> Nothing - (x:xs) -> Just (x, xs) - -charIf :: (Char -> Bool) -> Parser Char -charIf f = do - x <- char - if f x then return x else empty - -alphaNum :: Parser Char -alphaNum = charIf isAlphaNum - -digit :: Parser Char -digit = charIf isDigit - -num :: Parser Int -num = do - x <- some digit - return $ read x - -int :: Parser Int -int = - do - charIf $ \x -> x == '-' - x <- num - return (-x) - <|> - num - -maybeInt :: Parser (Maybe Int) -maybeInt = P $ \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 - - -data Option a = Option { - metavar :: String, - long :: String, - short :: String, - parser :: Parser a, - defaultValue :: Maybe a, - help :: String -} - -newtype Mod a = Mod (Option a -> Option a) - -instance Semigroup (Mod (a => Semigroup)) where - -- (<>) a -> a -> a - (<>) (Mod a) (Mod b) = Mod $ a <> b - --- option :: Parser a -> Mod Option a -> Parser a diff --git a/src/MyGetOpt.hs b/src/MyGetOpt.hs new file mode 100644 index 0000000..c3bfb9b --- /dev/null +++ b/src/MyGetOpt.hs @@ -0,0 +1,117 @@ +module MyGetOpt where + +import Control.Applicative +import Data.Char + +newtype Parser a = Parser { parse :: (String -> Maybe (a, String)) } + +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 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) + +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 (\_ -> Nothing) + + -- (<|>) :: 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) + +charIf :: (Char -> Bool) -> Parser Char +charIf f = do + x <- char + if f x then return x else empty + +alphaNum :: Parser Char +alphaNum = charIf isAlphaNum + +digit :: Parser Char +digit = charIf isDigit + +num :: Parser Int +num = do + x <- some digit + return $ read x + +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) + +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 +} deriving Show + +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 Int -> Mod Int -> IO() --Parser a +option p (Mod m) = print $ m def + where + def = Option "VAR" "" ' ' (Nothing :: Maybe Int) "No help message set." diff --git a/wolfram.cabal b/wolfram.cabal index ae5d895..e345c36 100644 --- a/wolfram.cabal +++ b/wolfram.cabal @@ -26,6 +26,7 @@ source-repository head library exposed-modules: Lib + MyGetOpt other-modules: Paths_wolfram hs-source-dirs: