Hi,

Here is a possible two part response.  Not literate code, just using >
to distinguish code from everything else.

A short answer
==============
> > getFilter = getString f "Markdown.pl"
> >     where f (Filter s) = Just s
> >           f _ = Nothing
> >
> > getDateFormat = getString f "%B %e, %Y"
> >     where f (DateFormat s) = Just s
> >           f _ = Nothing

For starters, you could squish these down into something like

> flagToString :: Flag -> Maybe String
> flagToString (Filter s) = Just s
> flagToString (DateFormat s) = Just s
> ...
> flagToString _ = Nothing
 
Then you would have
> getFilter = getString flagToString "Markdown.pl"
> getDateFormat = getString flagToString "%B %e, %Y"
 
A long answer
=============
I have noticed a lot of ways of dealing with GetOpt flags in Hakell
programs and thought it might be useful to catalogue them.  A lot of
this could be wrong btw, for example, advantages/disadvantages.  But I
think the general idea might be useful, so please add to this if you
see other solutions.

Solution #1 Ginormous record
----------------------------
Do you happen to have some giant recordful of command line parameters?
Something like

>  data Settings = Settings { filter     :: Maybe String
>                           , dateFormat :: Maybe String
>                           , blahBlah   :: Maybe Blah
>                           ...
>                           , thisIsGetting :: RatherLargeIsntIt
>                           }
>  
>  emptySettings :: Settings
>  emptySettings = Settings { filter = Nothing
>                           , dateFormat = Nothing 
>                           }
> 
>  toSettings :: [Flag] -> Settings
>  toSettings fs = toSettingsH fs emptySettings
>  
>  toSettingsH :: [Flag] -> Settings -> Settings
>  toSettingsH (Filter s:fs)     i = toSettingsH fs (i { filter = s })
>  toSettingsH (DateFormat s:fs) i = toSettingsH fs (i { dateFormat = i })
 
Note: You can make this a little less painful by factoring out the
recursion (took me a while to realise this!).

>  toSettings fs = foldr ($) emptySettings (map processFlag fs)
> 
>  processFlag :: Flag -> Settings -> Settings
>  processFlag (Filter s) i = i { filter = Just s }
>  processFlag (DateFormat s) i = i { dateFormat = s }
>  ...

Advantages:
  - simple, easy to look up settings

Disadvantages:
  boring; have to write
            (i)   Flag type
            (ii)  Settings record type
            (iii) default Settings 
            (iv)  processFlag entry
            (v)   GetOpt entry

  record gets really really huge if you have a lot of flags

Solution #2 List of flags (darcs) 
-------------------------
Don't bother keeping any records around, just pass around a big list of
flags to functions that depend on settings.

if the flag has any parameters, you can't just write (DateFormat
`elem` fs); you'll have to write some boilerplate along the lines
of

> hasDateFormat :: [Flag] -> Bool
> hasDateFormat (DateFormat s:fs) = True 
> hasDateFormat (_:fs) = hasDateFormat fs
> hasDateFormat []     = False 
> 
> getDateFormat :: [Flag] -> Maybe String
> getDateFormat (DateFormat s:fs) = Just s
> getDateFormat (_:fs) = getDateFormat fs
> getDateFormat []     = Nothing
 
which again can be factored out...

> fromDateFormat :: Flag -> Maybe String
> fromDateFormat (DateFormat x) = Just x
> fromDateFormat _ = Nothing
> 
> hasDateFormat fs = any (isJust.fromDateFormat) fs
> getDateFormat fs = listToMaybe $ mapMaybe fromDateFormat fs

Still, this is more pay-as-you-go in the sense that not all flags need
to be accessed, so maybe you end up writing less boilerplate overall

Advantages:
  simple
  very convenient to add flags (as a minimum, you have to write
    (i)   flag type
    (ii)  GetOpt entry
    (iii) lookup code (but pay-as-you-go)

Disadvantages:
  still a bit boilerplatey

Solution #3 No lists, just records (lhs2TeX)
----------------------------------
This one is due to Andres Löh, I think although my rendition of it may
not be as nice as his.

Ever considered that your Settings record could almost be your Flag
type?  The trick here is recognising that constructors are functions too
and what GetOpt really wants is just a function, not necessarily a
constructor.

> type Flag a = (a -> Settings -> Settings)
> 
> options :: [OptDescr Flag]
> options =
>   [ Option "f" ["filter"]
>       (ReqArg (\x s -> s { filter = Just x }) "TYPE")
>       "blahblah"
>   , Option "d" ["date-format"]
>       (ReqArg (\x s -> s { dateFormat = Just x }) "TYPE")
>       "blahblah"
> 
>   ]

Advantages:
  very convenient/compact; have to write
    (i)   Flag type
    (ii)  Settings record type/GetOpt in one go
    (iii) default Settings 
  easy to lookup flags
  
Disadvantages:
  Not as flexible
   - can't group flags into blocks and have different programs that use
     different subsets of flags (without sharing the same Setting type)
   - everything must go into Settings
   - seems harder to say stuff like 'if flag X is set and flag Y are in
     the list of Flags, then parameterise flag Z this way' or
     'flags X and Y are mutually exclusive'

Solution #4 List of flags + existential types (GenI)
---------------------------------------------
See attached code.  Basically motivated by your idea that we should be
able to pass constructors around like arguments.  Note: attached code
is written by very non-expert Eric.  So be ready to consider it wrong
and horrible in more ways than one can imagine.

Using it looks like this:

*Main> hasFlag LogFileFlag [ tf ]
False
*Main> hasFlag LogFileFlag [ lf, tf ]
True

*Main> [lf, tf]
[Flag LogFileFlag "hi",Flag TimeoutFlag 3]
*Main> setFlag LogFileFlag "bar" [ lf, tf ]
[Flag LogFileFlag "bar",Flag TimeoutFlag 3]
*Main> getFlag LogFileFlag [lf,tf]
Just "bar"

Advantages:
 - no more boilerplate only have to define
     (i) flag type, although ugly
     (ii) getopt stuff
 - extensible (as any list of flags approach)
 - mix-n-matchable (cf #3; different programs can share subset of flags)
 - can really just say 'getFlag FooFlag'
 - setFlag / deleteFlag

(I'm not claiming there are more advantages; it's just that I wrote this
 and can remember why)

Disadavantages:
 - can't enforce that some flags are always set (cf #1 and #4)
 - making things too complicated!
     existential types seems like overkill for GetOpt (well, I mostly
     did this to learn what they were)
 - ugly cpp macro or repetitive
     ata FilterFlag = FilterFlag String deriving (Eq, Show, Typeable)
     data TimeoutFlag = TimeoutFlag Int  deriving (Eq, Show, Typeable)
 - ugly GetOpt wrappers

reqArg :: forall f x . (Eq f, Show f, Typeable f, Eq x, Show x, Typeable x)
       => (x -> f)      -- ^ flag
       -> (String -> x) -- ^ string reader for flag (probably |id| if already a 
String)
       -> String        -- ^ description
       -> ArgDescr Flag
reqArg s fn desc = ReqArg (\x -> Flag s (fn x)) desc

-- 
Eric Kow                     http://www.loria.fr/~kow
PGP Key ID: 08AC04F9         Merci de corriger mon français.
This code is in the public domain.  Do whatever you want with it.
Eric Kow 2006-08-16

This is a library for dealing with optional command line arguments.

Note: you probably want to have a cpp macro that looks a little like this:
 #define FLAG(x,y) data x = x y deriving (Eq, Show, Typeable)

Some examples:

------------8<-----------------------------------------------------------
{-# OPTIONS_GHC -fglasgow-exts #-}

import Data.Typeable
import FlagsAndSwitches

data LogFileFlag = LogFileFlag String deriving (Eq, Show, Typeable)
data TimeoutFlag = TimeoutFlag Int    deriving (Eq, Show, Typeable)

lf = Flag LogFileFlag "hi"
tf = Flag TimeoutFlag 3
------------8<-----------------------------------------------------------

*Main> hasFlag LogFileFlag [ tf ]
False
*Main> hasFlag LogFileFlag [ lf, tf ]
True

*Main> [lf, tf]
[Flag LogFileFlag "hi",Flag TimeoutFlag 3]
*Main> setFlag LogFileFlag "bar" [ lf, tf ]
[Flag LogFileFlag "bar",Flag TimeoutFlag 3]
*Main> getFlag LogFileFlag [lf,tf]
Just "bar"

> {-# OPTIONS_GHC -fglasgow-exts #-}
> module FlagsAndSwitches where
>
> import Data.List (find)
> import Data.Typeable (Typeable, cast, typeOf)
>
> data Flag = forall f x . (Show f, Show x, Typeable f, Typeable x) => Flag (x 
> -> f) x deriving Typeable
>
> instance Show Flag where
>   show (Flag f x) = "Flag " ++ show (f x)

> isFlag     :: (Typeable f, Typeable x) => (x -> f) -> Flag -> Bool
> hasFlag    :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> Bool
> deleteFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> [Flag]
> setFlag    :: (Show f, Show x, Typeable f, Typeable x) => (x -> f) -> x -> 
> [Flag] -> [Flag]
> getFlag    :: (Show f, Show x, Typeable f, Typeable x) => (x -> f) -> [Flag] 
> -> Maybe x
>
> isFlag f1 (Flag f2 _) = typeOf f1 == typeOf f2
> hasFlag f      = any (isFlag f)
> deleteFlag f   = filter (not.isFlag f)
> setFlag f v fs = (Flag f v) : tl where tl = deleteFlag f fs
> getFlag f fs   = find (isFlag f) fs >>= cast

Attachment: pgp91qwIZwa3G.pgp
Description: PGP signature

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to