Skip to content
Snippets Groups Projects
Commit 78dcee7a authored by Alice Brenon's avatar Alice Brenon
Browse files

A simple way to express non-empty list of options

parent 603f11a8
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE NamedFieldPuns #-}
module GEODE.Options
( Output(..)
, atLeastOne
, output ) where
import Control.Applicative (optional)
import Control.Applicative ((<|>), empty, many, optional)
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.Maybe (catMaybes)
import Options.Applicative
( Parser, flag, help, long, metavar, short
( Parser, flag', help, long, metavar, short
, strOption )
data OutputFlags =
OutputFlags
{ metadata :: Maybe ()
, textRoot :: Maybe FilePath
, xmlRoot :: Maybe FilePath }
data Output = Metadata | TextRoot FilePath | XMLRoot FilePath
outputFlags :: Parser OutputFlags
outputFlags = OutputFlags
<$> flag Nothing (Just ())
( long "metadata"
<> short 'm'
<> help "Print metadata for splitted files on stdout" )
<*> (optional . strOption)
( long "text-root"
<> short 't'
<> metavar "DIRECTORY"
<> help "Path where to create files containing the text version of the articles" )
<*> (optional . strOption)
( long "xml-root"
<> short 'x'
<> metavar "DIRECTORY"
<> help "Path where to create files containing the XML" )
output :: Parser [Output]
output = catMaybes . toList <$> outputFlags
where
toList (OutputFlags {metadata, textRoot, xmlRoot}) =
[ Metadata <$ metadata, TextRoot <$> textRoot, XMLRoot <$> xmlRoot ]
output :: Parser Output
output =
flag' Metadata ( long "metadata" <> short 'm')
<|> (TextRoot <$> strOption ( long "text-root" <> short 't'))
<|> (TextRoot <$> strOption ( long "xml-root" <> short 'x'))
--atLeastOne :: [Output] -> IO [Output]
atLeastOne :: Parser a -> Parser (NonEmpty a)
atLeastOne p = (:|) <$> p <*> many p
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment