-- Copyright 2016 Google Inc. All Rights Reserved.
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | Adapting proto-lens to optparse-applicative ReadMs.
-- This gives an easy way to define options and arguments for
-- text-format protobuf types.
module Data.ProtoLens.Optparse
    ( -- * Messages
      proto
    , protoOption
    , protoArgument
      -- * Enums
    , protoEnum
    , enumOption
    , enumArgument
    ) where

import Control.Applicative ((<|>))
import Control.Monad ((<=<))
import Data.ProtoLens.Message (Message, MessageEnum(readEnum, maybeToEnum))
import Data.ProtoLens.TextFormat (readMessage)
import qualified Data.Text.Lazy as TL
import Options.Applicative
  ( ArgumentFields
  , Mod
  , ReadM
  , OptionFields
  , Parser
  , argument
  , eitherReader
  , option
  )
import Text.Read (readMaybe)

-- | An optparse-applicative 'ReadM' for a text-format protobuf.  This lets you
-- have flags or arguments with protobuf values.
proto :: Message a => ReadM a
proto :: forall a. Message a => ReadM a
proto = forall a. (String -> Either String a) -> ReadM a
eitherReader (forall msg. Message msg => Text -> Either String msg
readMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack)

-- | Shorthand for a text-format protobuf option.
protoOption :: Message a => Mod OptionFields a -> Parser a
protoOption :: forall a. Message a => Mod OptionFields a -> Parser a
protoOption = forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Message a => ReadM a
proto

-- | Shorthand for a text-format protobuf argument.
protoArgument :: Message a => Mod ArgumentFields a -> Parser a
protoArgument :: forall a. Message a => Mod ArgumentFields a -> Parser a
protoArgument = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall a. Message a => ReadM a
proto

-- We define our own maybeReader to preserve compatibility with versions of
-- optparse-applicative that don't provide it (< 0.13.0.0).
maybeReader :: (String -> Maybe a) -> ReadM a
maybeReader :: forall a. (String -> Maybe a) -> ReadM a
maybeReader = forall a. (String -> Either String a) -> ReadM a
eitherReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"No parse") forall a b. b -> Either a b
Right)

-- | An optparse-applicative 'ReadM' for an enum name or number.
protoEnum :: MessageEnum a => ReadM a
protoEnum :: forall a. MessageEnum a => ReadM a
protoEnum = forall a. (String -> Maybe a) -> ReadM a
maybeReader forall a. MessageEnum a => String -> Maybe a
readEnum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (String -> Maybe a) -> ReadM a
maybeReader (forall a. MessageEnum a => Int -> Maybe a
maybeToEnum forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Read a => String -> Maybe a
readMaybe)

-- | Shorthand for a text-format enumbuf option.
enumOption :: MessageEnum a => Mod OptionFields a -> Parser a
enumOption :: forall a. MessageEnum a => Mod OptionFields a -> Parser a
enumOption = forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. MessageEnum a => ReadM a
protoEnum

-- | Shorthand for a text-format enumbuf argument.
enumArgument :: MessageEnum a => Mod ArgumentFields a -> Parser a
enumArgument :: forall a. MessageEnum a => Mod ArgumentFields a -> Parser a
enumArgument = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall a. MessageEnum a => ReadM a
protoEnum