mirror of
https://github.com/zoriya/applicative-getopt.git
synced 2025-12-06 05:36:09 +00:00
Basic parsing now works!
This commit is contained in:
5
.gitignore
vendored
5
.gitignore
vendored
@@ -1,4 +1,7 @@
|
||||
.stack-work/
|
||||
*~
|
||||
.idea/
|
||||
wolfram
|
||||
.vscode/
|
||||
**/*.hi
|
||||
**/*.o
|
||||
Main
|
||||
34
GetOpt.hs
34
GetOpt.hs
@@ -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)
|
||||
@@ -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)
|
||||
@@ -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
|
||||
@@ -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
37
Main.hs
Normal 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
|
||||
|
||||
Reference in New Issue
Block a user