{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Servant.CLI.ParseBody
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provides the interface for 'ParseBody', a helper class for defining
-- directly how to parse request bodies.
module Servant.CLI.ParseBody
  ( ParseBody (..),
    defaultParseBody,
  )
where

import Data.Char
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Options.Applicative
import Text.Printf
import Type.Reflection

-- | A helper class for defining directly how to parse request bodies.
-- This allows more complex parsing of bodies.
--
-- You need an instance of this for every type you use with
-- 'Servant.API.ReqBody'.
class ParseBody a where
  parseBody :: Parser a
  default parseBody :: (Typeable a, Read a) => Parser a
  parseBody = String -> ReadM a -> Parser a
forall a. String -> ReadM a -> Parser a
defaultParseBody (TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)) ReadM a
forall a. Read a => ReadM a
auto

-- | Default implementation that expects a @--data@ option.
defaultParseBody ::
  -- | type specification
  String ->
  -- | parser
  ReadM a ->
  Parser a
defaultParseBody :: forall a. String -> ReadM a -> Parser a
defaultParseBody String
mv ReadM a
r =
  ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM a
r
    ( String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"<%s>" ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
mv))
        Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"data"
        Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
        Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields a
forall (f :: * -> *) a. String -> Mod f a
help (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Request body (%s)" String
mv)
    )

instance ParseBody T.Text where
  parseBody :: Parser Text
parseBody = String -> ReadM Text -> Parser Text
forall a. String -> ReadM a -> Parser a
defaultParseBody String
"Text" ReadM Text
forall s. IsString s => ReadM s
str

instance ParseBody TL.Text where
  parseBody :: Parser Text
parseBody = String -> ReadM Text -> Parser Text
forall a. String -> ReadM a -> Parser a
defaultParseBody String
"Text" ReadM Text
forall s. IsString s => ReadM s
str

instance ParseBody Int

instance ParseBody Integer

instance ParseBody Float

instance ParseBody Double