-- | This module contains the definition of a 'Decoder'
--   and some default decoders
--
--   A 'Decoder' reads a string and return a Haskell value or a failure
module Data.Registry.Options.Decoder where

import Data.Registry (ApplyVariadic, Typed, fun, funTo)
import qualified Data.Text as T
import Protolude
import Prelude (String)

-- | Decode a value of type a from Text
newtype Decoder a = Decoder {forall a. Decoder a -> Text -> Either Text a
decode :: Text -> Either Text a}
  deriving ((forall a b. (a -> b) -> Decoder a -> Decoder b)
-> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
forall a b. a -> Decoder b -> Decoder a
forall a b. (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Decoder b -> Decoder a
$c<$ :: forall a b. a -> Decoder b -> Decoder a
fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
$cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
Functor, Functor Decoder
Functor Decoder
-> (forall a. a -> Decoder a)
-> (forall a b. Decoder (a -> b) -> Decoder a -> Decoder b)
-> (forall a b c.
    (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c)
-> (forall a b. Decoder a -> Decoder b -> Decoder b)
-> (forall a b. Decoder a -> Decoder b -> Decoder a)
-> Applicative Decoder
forall a. a -> Decoder a
forall a b. Decoder a -> Decoder b -> Decoder a
forall a b. Decoder a -> Decoder b -> Decoder b
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Decoder a -> Decoder b -> Decoder a
$c<* :: forall a b. Decoder a -> Decoder b -> Decoder a
*> :: forall a b. Decoder a -> Decoder b -> Decoder b
$c*> :: forall a b. Decoder a -> Decoder b -> Decoder b
liftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
$cliftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
$c<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
pure :: forall a. a -> Decoder a
$cpure :: forall a. a -> Decoder a
Applicative, Applicative Decoder
Applicative Decoder
-> (forall a b. Decoder a -> (a -> Decoder b) -> Decoder b)
-> (forall a b. Decoder a -> Decoder b -> Decoder b)
-> (forall a. a -> Decoder a)
-> Monad Decoder
forall a. a -> Decoder a
forall a b. Decoder a -> Decoder b -> Decoder b
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Decoder a
$creturn :: forall a. a -> Decoder a
>> :: forall a b. Decoder a -> Decoder b -> Decoder b
$c>> :: forall a b. Decoder a -> Decoder b -> Decoder b
>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
$c>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
Monad) via (ReaderT Text (Either Text))

-- | Create a Decoder a for a given constructor of type a
decoderOf :: forall a b. (ApplyVariadic Decoder a b, Typeable a, Typeable b) => a -> Typed b
decoderOf :: forall a b.
(ApplyVariadic Decoder a b, Typeable a, Typeable b) =>
a -> Typed b
decoderOf = forall (m :: * -> *) a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
funTo @Decoder

-- | Add a Decoder to a registry
addDecoder :: forall a. (Typeable a) => (Text -> Either Text a) -> Typed (Decoder a)
addDecoder :: forall a.
Typeable a =>
(Text -> Either Text a) -> Typed (Decoder a)
addDecoder = Decoder a -> Typed (Decoder a)
forall a. Typeable a => a -> Typed a
fun (Decoder a -> Typed (Decoder a))
-> ((Text -> Either Text a) -> Decoder a)
-> (Text -> Either Text a)
-> Typed (Decoder a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text a) -> Decoder a
forall a. (Text -> Either Text a) -> Decoder a
Decoder

-- * Common decoders

-- | Decoder for an Int
intDecoder :: Text -> Either Text Int
intDecoder :: Text -> Either Text Int
intDecoder Text
t = Either Text Int
-> (Int -> Either Text Int) -> Maybe Int -> Either Text Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Int
forall a b. a -> Either a b
Left (Text -> Either Text Int) -> Text -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Text
"cannot read as an Int: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Int -> Either Text Int
forall a b. b -> Either a b
Right (Text -> Maybe Int
forall b a. (Read b, StringConv a String) => a -> Maybe b
readMaybe Text
t)

-- | Decoder for a Bool
boolDecoder :: Text -> Either Text Bool
boolDecoder :: Text -> Either Text Bool
boolDecoder Text
t = Either Text Bool
-> (Bool -> Either Text Bool) -> Maybe Bool -> Either Text Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Text
"cannot read as a Bool: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Text -> Maybe Bool
forall b a. (Read b, StringConv a String) => a -> Maybe b
readMaybe Text
t)

-- | Decoder for some Text
textDecoder :: Text -> Either Text Text
textDecoder :: Text -> Either Text Text
textDecoder Text
t = if Text -> Bool
T.null Text
t then Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"empty text" else Text -> Either Text Text
forall a b. b -> Either a b
Right Text
t

-- | Decoder for some String
stringDecoder :: Text -> Either Text String
stringDecoder :: Text -> Either Text String
stringDecoder Text
t = if Text -> Bool
T.null Text
t then Text -> Either Text String
forall a b. a -> Either a b
Left Text
"empty string" else String -> Either Text String
forall a b. b -> Either a b
Right (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
t)

-- | Create a Decoder for [a]
manyOf :: forall a. Typeable a => Typed (Decoder a -> Decoder [a])
manyOf :: forall a. Typeable a => Typed (Decoder a -> Decoder [a])
manyOf = (Decoder a -> Decoder [a]) -> Typed (Decoder a -> Decoder [a])
forall a. Typeable a => a -> Typed a
fun Decoder a -> Decoder [a]
forall a. Typeable a => Decoder a -> Decoder [a]
decodeMany

-- | Create a Decoder for [a] as a comma-separated string
decodeMany :: forall a. Typeable a => Decoder a -> Decoder [a]
decodeMany :: forall a. Typeable a => Decoder a -> Decoder [a]
decodeMany = Text -> Decoder a -> Decoder [a]
forall a. Typeable a => Text -> Decoder a -> Decoder [a]
decodeManySeparated Text
","

-- | Create a Decoder for [a] as a separated string
decodeManySeparated :: forall a. Typeable a => Text -> Decoder a -> Decoder [a]
decodeManySeparated :: forall a. Typeable a => Text -> Decoder a -> Decoder [a]
decodeManySeparated Text
separator Decoder a
d = (Text -> Either Text [a]) -> Decoder [a]
forall a. (Text -> Either Text a) -> Decoder a
Decoder ((Text -> Either Text [a]) -> Decoder [a])
-> (Text -> Either Text [a]) -> Decoder [a]
forall a b. (a -> b) -> a -> b
$ \Text
t -> [Text] -> (Text -> Either Text a) -> Either Text [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Text -> Text
T.strip (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
separator Text
t) (Decoder a -> Text -> Either Text a
forall a. Decoder a -> Text -> Either Text a
decode Decoder a
d)