module Distribution.Deprecated.ViewAsFieldDescr (
    viewAsFieldDescr
    ) where

import Distribution.Client.Compat.Prelude hiding (get)
import Prelude ()

import qualified Data.List.NonEmpty as NE
import Distribution.ReadE          (parsecToReadE)
import Distribution.Simple.Command
import Text.PrettyPrint            (cat, comma, punctuate, text)
import Text.PrettyPrint            as PP (empty)

import Distribution.Deprecated.ParseUtils (FieldDescr (..), runE, syntaxError)

-- | to view as a FieldDescr, we sort the list of interfaces (Req > Bool >
-- Choice > Opt) and consider only the first one.
viewAsFieldDescr :: OptionField a -> FieldDescr a
viewAsFieldDescr :: forall a. OptionField a -> FieldDescr a
viewAsFieldDescr (OptionField Name
_n []) =
  forall a. HasCallStack => Name -> a
error Name
"Distribution.command.viewAsFieldDescr: unexpected"
viewAsFieldDescr (OptionField Name
n (OptDescr a
d:[OptDescr a]
dd)) = forall a.
Name
-> (a -> Doc)
-> (LineNo -> Name -> a -> ParseResult a)
-> FieldDescr a
FieldDescr Name
n a -> Doc
get LineNo -> Name -> a -> ParseResult a
set

    where
      optDescr :: OptDescr a
optDescr = forall a. NonEmpty a -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy forall a. OptDescr a -> OptDescr a -> Ordering
cmp (OptDescr a
dforall a. a -> [a] -> NonEmpty a
:|[OptDescr a]
dd)

      cmp :: OptDescr a -> OptDescr a -> Ordering
      ReqArg{}    cmp :: forall a. OptDescr a -> OptDescr a -> Ordering
`cmp` ReqArg{}    = Ordering
EQ
      ReqArg{}    `cmp` OptDescr a
_           = Ordering
GT
      BoolOpt{}   `cmp` ReqArg{}    = Ordering
LT
      BoolOpt{}   `cmp` BoolOpt{}   = Ordering
EQ
      BoolOpt{}   `cmp` OptDescr a
_           = Ordering
GT
      ChoiceOpt{} `cmp` ReqArg{}    = Ordering
LT
      ChoiceOpt{} `cmp` BoolOpt{}   = Ordering
LT
      ChoiceOpt{} `cmp` ChoiceOpt{} = Ordering
EQ
      ChoiceOpt{} `cmp` OptDescr a
_           = Ordering
GT
      OptArg{}    `cmp` OptArg{}    = Ordering
EQ
      OptArg{}    `cmp` OptDescr a
_           = Ordering
LT

--    get :: a -> Doc
      get :: a -> Doc
get a
t = case OptDescr a
optDescr of
        ReqArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
_ a -> [Name]
ppr ->
          ([Doc] -> Doc
cat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Name]
ppr) a
t

        OptArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
_ a -> a
_ a -> [Maybe Name]
ppr ->
          case a -> [Maybe Name]
ppr a
t of []        -> Doc
PP.empty
                        (Maybe Name
Nothing : [Maybe Name]
_) -> Name -> Doc
text Name
"True"
                        (Just Name
a  : [Maybe Name]
_) -> Name -> Doc
text Name
a

        ChoiceOpt [(Name, OptFlags, a -> a, a -> Bool)]
alts ->
          forall a. a -> Maybe a -> a
fromMaybe Doc
PP.empty forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe
          [ Name -> Doc
text Name
lf | (Name
_,(Name
_,Name
lf:[Name]
_), a -> a
_,a -> Bool
enabled) <- [(Name, OptFlags, a -> a, a -> Bool)]
alts, a -> Bool
enabled a
t]

        BoolOpt Name
_ OptFlags
_ OptFlags
_ Bool -> a -> a
_ a -> Maybe Bool
enabled -> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
PP.empty forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Bool
enabled) a
t

--    set :: LineNo -> String -> a -> ParseResult a
      set :: LineNo -> Name -> a -> ParseResult a
set LineNo
line Name
val a
a =
        case OptDescr a
optDescr of
          ReqArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
readE a -> [Name]
_    -> (forall a b. (a -> b) -> a -> b
$ a
a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. LineNo -> Name -> ReadE a -> Name -> ParseResult a
runE LineNo
line Name
n ReadE (a -> a)
readE Name
val
                                     -- We parse for a single value instead of a
                                     -- list, as one can't really implement
                                     -- parseList :: ReadE a -> ReadE [a] with
                                     -- the current ReadE definition
          ChoiceOpt{}             ->
            case forall a. OptDescr a -> Name -> Maybe (a -> a)
getChoiceByLongFlag OptDescr a
optDescr Name
val of
              Just a -> a
f -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
f a
a)
              Maybe (a -> a)
_      -> forall a. LineNo -> Name -> ParseResult a
syntaxError LineNo
line Name
val

          BoolOpt Name
_ OptFlags
_ OptFlags
_ Bool -> a -> a
setV a -> Maybe Bool
_    -> (Bool -> a -> a
`setV` a
a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. LineNo -> Name -> ReadE a -> Name -> ParseResult a
runE LineNo
line Name
n (forall a. (Name -> Name) -> ParsecParser a -> ReadE a
parsecToReadE (Name
"<viewAsFieldDescr>" forall a. [a] -> [a] -> [a]
++) forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) Name
val

          OptArg Name
_ OptFlags
_ Name
_  ReadE (a -> a)
readE a -> a
_ a -> [Maybe Name]
_ -> (forall a b. (a -> b) -> a -> b
$ a
a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. LineNo -> Name -> ReadE a -> Name -> ParseResult a
runE LineNo
line Name
n ReadE (a -> a)
readE Name
val
                                     -- Optional arguments are parsed just like
                                     -- required arguments here; we don't
                                     -- provide a method to set an OptArg field
                                     -- to the default value.

getChoiceByLongFlag :: OptDescr a -> String -> Maybe (a -> a)
getChoiceByLongFlag :: forall a. OptDescr a -> Name -> Maybe (a -> a)
getChoiceByLongFlag (ChoiceOpt [(Name, OptFlags, a -> a, a -> Bool)]
alts) Name
val = forall a. [a] -> Maybe a
listToMaybe
                                           [ a -> a
set | (Name
_,(Name
_sf,Name
lf:[Name]
_), a -> a
set, a -> Bool
_) <- [(Name, OptFlags, a -> a, a -> Bool)]
alts
                                                 , Name
lf forall a. Eq a => a -> a -> Bool
== Name
val]

getChoiceByLongFlag OptDescr a
_ Name
_ =
  forall a. HasCallStack => Name -> a
error Name
"Distribution.command.getChoiceByLongFlag: expected a choice option"