never executed always true always false

    1 module Distribution.Deprecated.ViewAsFieldDescr (
    2     viewAsFieldDescr
    3     ) where
    4 
    5 import Distribution.Client.Compat.Prelude hiding (get)
    6 import Prelude ()
    7 
    8 import qualified Data.List.NonEmpty as NE
    9 import Distribution.ReadE          (parsecToReadE)
   10 import Distribution.Simple.Command
   11 import Text.PrettyPrint            (cat, comma, punctuate, text)
   12 import Text.PrettyPrint            as PP (empty)
   13 
   14 import Distribution.Deprecated.ParseUtils (FieldDescr (..), runE, syntaxError)
   15 
   16 -- | to view as a FieldDescr, we sort the list of interfaces (Req > Bool >
   17 -- Choice > Opt) and consider only the first one.
   18 viewAsFieldDescr :: OptionField a -> FieldDescr a
   19 viewAsFieldDescr (OptionField _n []) =
   20   error "Distribution.command.viewAsFieldDescr: unexpected"
   21 viewAsFieldDescr (OptionField n (d:dd)) = FieldDescr n get set
   22 
   23     where
   24       optDescr = head $ NE.sortBy cmp (d:|dd)
   25 
   26       cmp :: OptDescr a -> OptDescr a -> Ordering
   27       ReqArg{}    `cmp` ReqArg{}    = EQ
   28       ReqArg{}    `cmp` _           = GT
   29       BoolOpt{}   `cmp` ReqArg{}    = LT
   30       BoolOpt{}   `cmp` BoolOpt{}   = EQ
   31       BoolOpt{}   `cmp` _           = GT
   32       ChoiceOpt{} `cmp` ReqArg{}    = LT
   33       ChoiceOpt{} `cmp` BoolOpt{}   = LT
   34       ChoiceOpt{} `cmp` ChoiceOpt{} = EQ
   35       ChoiceOpt{} `cmp` _           = GT
   36       OptArg{}    `cmp` OptArg{}    = EQ
   37       OptArg{}    `cmp` _           = LT
   38 
   39 --    get :: a -> Doc
   40       get t = case optDescr of
   41         ReqArg _ _ _ _ ppr ->
   42           (cat . punctuate comma . map text . ppr) t
   43 
   44         OptArg _ _ _ _ _ ppr ->
   45           case ppr t of []        -> PP.empty
   46                         (Nothing : _) -> text "True"
   47                         (Just a  : _) -> text a
   48 
   49         ChoiceOpt alts ->
   50           fromMaybe PP.empty $ listToMaybe
   51           [ text lf | (_,(_,lf:_), _,enabled) <- alts, enabled t]
   52 
   53         BoolOpt _ _ _ _ enabled -> (maybe PP.empty pretty . enabled) t
   54 
   55 --    set :: LineNo -> String -> a -> ParseResult a
   56       set line val a =
   57         case optDescr of
   58           ReqArg _ _ _ readE _    -> ($ a) `liftM` runE line n readE val
   59                                      -- We parse for a single value instead of a
   60                                      -- list, as one can't really implement
   61                                      -- parseList :: ReadE a -> ReadE [a] with
   62                                      -- the current ReadE definition
   63           ChoiceOpt{}             ->
   64             case getChoiceByLongFlag optDescr val of
   65               Just f -> return (f a)
   66               _      -> syntaxError line val
   67 
   68           BoolOpt _ _ _ setV _    -> (`setV` a) `liftM` runE line n (parsecToReadE ("<viewAsFieldDescr>" ++) parsec) val
   69 
   70           OptArg _ _ _  readE _ _ -> ($ a) `liftM` runE line n readE val
   71                                      -- Optional arguments are parsed just like
   72                                      -- required arguments here; we don't
   73                                      -- provide a method to set an OptArg field
   74                                      -- to the default value.
   75 
   76 getChoiceByLongFlag :: OptDescr a -> String -> Maybe (a -> a)
   77 getChoiceByLongFlag (ChoiceOpt alts) val = listToMaybe
   78                                            [ set | (_,(_sf,lf:_), set, _) <- alts
   79                                                  , lf == val]
   80 
   81 getChoiceByLongFlag _ _ =
   82   error "Distribution.command.getChoiceByLongFlag: expected a choice option"
   83 
   84