Basic parsing now works!

This commit is contained in:
Zoe Roux
2021-03-10 19:16:07 +01:00
parent 9b78c23a11
commit a782b61527
6 changed files with 90 additions and 27 deletions

5
.gitignore vendored
View File

@@ -1,4 +1,7 @@
.stack-work/
*~
.idea/
wolfram
.vscode/
**/*.hi
**/*.o
Main

View File

@@ -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)
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)

View File

@@ -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
}
}
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)

View File

@@ -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
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

View File

@@ -1,3 +1,14 @@
{-# LANGUAGE GADTs #-}
module GetOpt.Parsers where
import GetOpt.Data
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

37
Main.hs Normal file
View File

@@ -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