{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}

module TOML.Decode (
  -- * Decoding functions
  decode,
  decodeWith,
  decodeWithOpts,
  decodeFile,

  -- * Decoder interface
  DecodeTOML (..),
  Decoder (..),

  -- ** Decoder getters
  getField,
  getFields,
  getFieldOpt,
  getFieldsOpt,
  getFieldWith,
  getFieldsWith,
  getFieldOptWith,
  getFieldsOptWith,
  getArrayOf,

  -- ** Build custom Decoder
  DecodeM (..),
  makeDecoder,
  runDecoder,
  addContextItem,
  invalidValue,
  typeMismatch,
  decodeFail,
  decodeError,
) where

import Control.Applicative (Alternative (..), Const (..))
import Control.Monad (zipWithM)
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail as MonadFail
#endif
import Data.Bifunctor (first)
import Data.Fixed (Fixed, HasResolution)
import Data.Functor.Identity (Identity (..))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Monoid as Monoid
import Data.Proxy (Proxy (..))
import Data.Ratio (Ratio)
import qualified Data.Semigroup as Semigroup
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Time as Time
import qualified Data.Time.Clock.System as Time
import Data.Version (Version, parseVersion)
import Data.Void (Void)
import Data.Word (Word16, Word32, Word64, Word8)
import Numeric.Natural (Natural)
import Text.ParserCombinators.ReadP (readP_to_S)

import TOML.Error (
  ContextItem (..),
  DecodeContext,
  DecodeError (..),
  TOMLError (..),
 )
import TOML.Parser (parseTOML)
import TOML.Value (Value (..))

{--- Decoder ---}

{- |
A @Decoder a@ represents a function for decoding a TOML value to a value of type @a@.

Generally, you'd only need to chain the @getField*@ functions together, like

@
decoder =
  MyConfig
    \<$> getField "a"
    \<*> getField "b"
    \<*> getField "c"
@

or use interfaces like 'Monad' and 'Alternative':

@
decoder = do
  cfgType <- getField "type"
  case cfgType of
    "int" -> MyIntValue \<$> (getField "int" \<|> getField "integer")
    "bool" -> MyBoolValue \<$> getField "bool"
    _ -> fail $ "Invalid type: " <> cfgType
@

but you can also manually implement a 'Decoder' with 'makeDecoder'.
-}
newtype Decoder a = Decoder {Decoder a -> Value -> DecodeM a
unDecoder :: Value -> DecodeM a}

instance Functor Decoder where
  fmap :: (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f = (Value -> DecodeM b) -> Decoder b
forall a. (Value -> DecodeM a) -> Decoder a
Decoder ((Value -> DecodeM b) -> Decoder b)
-> (Decoder a -> Value -> DecodeM b) -> Decoder a -> Decoder b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DecodeM a -> DecodeM b)
-> (Value -> DecodeM a) -> Value -> DecodeM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DecodeM a -> DecodeM b)
 -> (Value -> DecodeM a) -> Value -> DecodeM b)
-> ((a -> b) -> DecodeM a -> DecodeM b)
-> (a -> b)
-> (Value -> DecodeM a)
-> Value
-> DecodeM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> DecodeM a -> DecodeM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f ((Value -> DecodeM a) -> Value -> DecodeM b)
-> (Decoder a -> Value -> DecodeM a)
-> Decoder a
-> Value
-> DecodeM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Value -> DecodeM a
forall a. Decoder a -> Value -> DecodeM a
unDecoder
instance Applicative Decoder where
  pure :: a -> Decoder a
pure a
v = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
Decoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
_ -> a -> DecodeM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
  Decoder Value -> DecodeM (a -> b)
decodeF <*> :: Decoder (a -> b) -> Decoder a -> Decoder b
<*> Decoder Value -> DecodeM a
decodeV = (Value -> DecodeM b) -> Decoder b
forall a. (Value -> DecodeM a) -> Decoder a
Decoder ((Value -> DecodeM b) -> Decoder b)
-> (Value -> DecodeM b) -> Decoder b
forall a b. (a -> b) -> a -> b
$ \Value
v -> Value -> DecodeM (a -> b)
decodeF Value
v DecodeM (a -> b) -> DecodeM a -> DecodeM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> DecodeM a
decodeV Value
v
instance Monad Decoder where
  Decoder Value -> DecodeM a
decodeA >>= :: Decoder a -> (a -> Decoder b) -> Decoder b
>>= a -> Decoder b
f = (Value -> DecodeM b) -> Decoder b
forall a. (Value -> DecodeM a) -> Decoder a
Decoder ((Value -> DecodeM b) -> Decoder b)
-> (Value -> DecodeM b) -> Decoder b
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
    a
a <- Value -> DecodeM a
decodeA Value
v
    let Decoder Value -> DecodeM b
decodeB = a -> Decoder b
f a
a
    Value -> DecodeM b
decodeB Value
v
#if !MIN_VERSION_base(4,13,0)
  fail msg = Decoder $ \_ -> decodeFail $ Text.pack msg
#endif
instance Alternative Decoder where
  empty :: Decoder a
empty = String -> Decoder a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Decoder.Alternative: empty"
  Decoder Value -> DecodeM a
decode1 <|> :: Decoder a -> Decoder a -> Decoder a
<|> Decoder Value -> DecodeM a
decode2 = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
Decoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
v -> Value -> DecodeM a
decode1 Value
v DecodeM a -> DecodeM a -> DecodeM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> DecodeM a
decode2 Value
v
#if MIN_VERSION_base(4,13,0)
instance MonadFail Decoder where
  fail :: String -> Decoder a
fail String
msg = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
Decoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Value
_ -> Text -> DecodeM a
forall a. Text -> DecodeM a
decodeFail (Text -> DecodeM a) -> Text -> DecodeM a
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
msg
#elif MIN_VERSION_base(4,9,0)
instance MonadFail.MonadFail Decoder where
  fail msg = Decoder $ \_ -> decodeFail $ Text.pack msg
#endif

-- | Manually implement a 'Decoder' with the given function.
makeDecoder :: (Value -> DecodeM a) -> Decoder a
makeDecoder :: (Value -> DecodeM a) -> Decoder a
makeDecoder = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
Decoder

decoderToEither :: Decoder a -> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a
decoderToEither :: Decoder a
-> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a
decoderToEither Decoder a
decoder Value
v DecodeContext
ctx = DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
forall a.
DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
unDecodeM (Decoder a -> Value -> DecodeM a
forall a. Decoder a -> Value -> DecodeM a
unDecoder Decoder a
decoder Value
v) DecodeContext
ctx

-- | The underlying decoding monad that either returns a value of type @a@ or returns an error.
newtype DecodeM a = DecodeM {DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
unDecodeM :: DecodeContext -> Either (DecodeContext, DecodeError) a}

instance Functor DecodeM where
  fmap :: (a -> b) -> DecodeM a -> DecodeM b
fmap a -> b
f = (DecodeContext -> Either (DecodeContext, DecodeError) b)
-> DecodeM b
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) b)
 -> DecodeM b)
-> (DecodeM a
    -> DecodeContext -> Either (DecodeContext, DecodeError) b)
-> DecodeM a
-> DecodeM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either (DecodeContext, DecodeError) a
 -> Either (DecodeContext, DecodeError) b)
-> (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeContext
-> Either (DecodeContext, DecodeError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (DecodeContext, DecodeError) a
  -> Either (DecodeContext, DecodeError) b)
 -> (DecodeContext -> Either (DecodeContext, DecodeError) a)
 -> DecodeContext
 -> Either (DecodeContext, DecodeError) b)
-> ((a -> b)
    -> Either (DecodeContext, DecodeError) a
    -> Either (DecodeContext, DecodeError) b)
-> (a -> b)
-> (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeContext
-> Either (DecodeContext, DecodeError) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b)
-> Either (DecodeContext, DecodeError) a
-> Either (DecodeContext, DecodeError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f ((DecodeContext -> Either (DecodeContext, DecodeError) a)
 -> DecodeContext -> Either (DecodeContext, DecodeError) b)
-> (DecodeM a
    -> DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
-> DecodeContext
-> Either (DecodeContext, DecodeError) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
forall a.
DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
unDecodeM
instance Applicative DecodeM where
  pure :: a -> DecodeM a
pure a
v = (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) a)
 -> DecodeM a)
-> (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a b. (a -> b) -> a -> b
$ \DecodeContext
_ -> a -> Either (DecodeContext, DecodeError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
  DecodeM DecodeContext -> Either (DecodeContext, DecodeError) (a -> b)
decodeF <*> :: DecodeM (a -> b) -> DecodeM a -> DecodeM b
<*> DecodeM DecodeContext -> Either (DecodeContext, DecodeError) a
decodeV = (DecodeContext -> Either (DecodeContext, DecodeError) b)
-> DecodeM b
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) b)
 -> DecodeM b)
-> (DecodeContext -> Either (DecodeContext, DecodeError) b)
-> DecodeM b
forall a b. (a -> b) -> a -> b
$ \DecodeContext
ctx -> DecodeContext -> Either (DecodeContext, DecodeError) (a -> b)
decodeF DecodeContext
ctx Either (DecodeContext, DecodeError) (a -> b)
-> Either (DecodeContext, DecodeError) a
-> Either (DecodeContext, DecodeError) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DecodeContext -> Either (DecodeContext, DecodeError) a
decodeV DecodeContext
ctx
instance Monad DecodeM where
  DecodeM DecodeContext -> Either (DecodeContext, DecodeError) a
decodeA >>= :: DecodeM a -> (a -> DecodeM b) -> DecodeM b
>>= a -> DecodeM b
f = (DecodeContext -> Either (DecodeContext, DecodeError) b)
-> DecodeM b
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) b)
 -> DecodeM b)
-> (DecodeContext -> Either (DecodeContext, DecodeError) b)
-> DecodeM b
forall a b. (a -> b) -> a -> b
$ \DecodeContext
ctx -> do
    a
a <- DecodeContext -> Either (DecodeContext, DecodeError) a
decodeA DecodeContext
ctx
    let DecodeM DecodeContext -> Either (DecodeContext, DecodeError) b
decodeB = a -> DecodeM b
f a
a
    DecodeContext -> Either (DecodeContext, DecodeError) b
decodeB DecodeContext
ctx
#if !MIN_VERSION_base(4,13,0)
  fail = decodeFail . Text.pack
#endif
instance Alternative DecodeM where
  empty :: DecodeM a
empty = Text -> DecodeM a
forall a. Text -> DecodeM a
decodeFail Text
"DecodeM.Alternative: empty"
  DecodeM DecodeContext -> Either (DecodeContext, DecodeError) a
decode1 <|> :: DecodeM a -> DecodeM a -> DecodeM a
<|> DecodeM DecodeContext -> Either (DecodeContext, DecodeError) a
decode2 = (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) a)
 -> DecodeM a)
-> (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a b. (a -> b) -> a -> b
$ \DecodeContext
ctx ->
    case DecodeContext -> Either (DecodeContext, DecodeError) a
decode1 DecodeContext
ctx of
      Left (DecodeContext, DecodeError)
_ -> DecodeContext -> Either (DecodeContext, DecodeError) a
decode2 DecodeContext
ctx
      Right a
x -> a -> Either (DecodeContext, DecodeError) a
forall a b. b -> Either a b
Right a
x
#if MIN_VERSION_base(4,13,0)
instance MonadFail DecodeM where
  fail :: String -> DecodeM a
fail = Text -> DecodeM a
forall a. Text -> DecodeM a
decodeFail (Text -> DecodeM a) -> (String -> Text) -> String -> DecodeM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
#elif MIN_VERSION_base(4,9,0)
instance MonadFail.MonadFail DecodeM where
  fail = decodeFail . Text.pack
#endif

{- |
Run a 'Decoder' with the given 'Value'.

@
makeDecoder $ \\v -> do
  a <- runDecoder decoder1 v
  b <- runDecoder decoder2 v
  return (a, b)
@

Satisfies

@
makeDecoder . runDecoder === id
runDecoder . makeDecoder === id
@
-}
runDecoder :: Decoder a -> Value -> DecodeM a
runDecoder :: Decoder a -> Value -> DecodeM a
runDecoder Decoder a
decoder Value
v = (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM (Decoder a
-> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a
forall a.
Decoder a
-> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a
decoderToEither Decoder a
decoder Value
v)

{- |
Throw an error indicating that the given 'Value' is invalid.

@
makeDecoder $ \\v ->
  case v of
    Integer 42 -> invalidValue "We don't like this number" v
    _ -> runDecoder tomlDecoder v

-- or alternatively,
tomlDecoder >>= \case
  42 -> makeDecoder $ invalidValue "We don't like this number"
  v -> pure v
@
-}
invalidValue :: Text -> Value -> DecodeM a
invalidValue :: Text -> Value -> DecodeM a
invalidValue Text
msg Value
v = DecodeError -> DecodeM a
forall a. DecodeError -> DecodeM a
decodeError (DecodeError -> DecodeM a) -> DecodeError -> DecodeM a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeError
InvalidValue Text
msg Value
v

{- |
Throw an error indicating that the given 'Value' isn't the correct type of value.

@
makeDecoder $ \\v ->
  case v of
    String s -> ...
    _ -> typeMismatch v
@
-}
typeMismatch :: Value -> DecodeM a
typeMismatch :: Value -> DecodeM a
typeMismatch Value
v = DecodeError -> DecodeM a
forall a. DecodeError -> DecodeM a
decodeError (DecodeError -> DecodeM a) -> DecodeError -> DecodeM a
forall a b. (a -> b) -> a -> b
$ Value -> DecodeError
TypeMismatch Value
v

-- | Throw a generic failure message.
decodeFail :: Text -> DecodeM a
decodeFail :: Text -> DecodeM a
decodeFail Text
msg = DecodeError -> DecodeM a
forall a. DecodeError -> DecodeM a
decodeError (DecodeError -> DecodeM a) -> DecodeError -> DecodeM a
forall a b. (a -> b) -> a -> b
$ Text -> DecodeError
OtherDecodeError Text
msg

-- | Throw the given 'DecodeError'.
decodeError :: DecodeError -> DecodeM a
decodeError :: DecodeError -> DecodeM a
decodeError DecodeError
e = (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) a)
 -> DecodeM a)
-> (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a b. (a -> b) -> a -> b
$ \DecodeContext
ctx -> (DecodeContext, DecodeError)
-> Either (DecodeContext, DecodeError) a
forall a b. a -> Either a b
Left (DecodeContext
ctx, DecodeError
e)

addContextItem :: ContextItem -> DecodeM a -> DecodeM a
addContextItem :: ContextItem -> DecodeM a -> DecodeM a
addContextItem ContextItem
p DecodeM a
m = (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) a)
 -> DecodeM a)
-> (DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
forall a b. (a -> b) -> a -> b
$ \DecodeContext
ctx -> DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
forall a.
DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
unDecodeM DecodeM a
m (DecodeContext
ctx DecodeContext -> DecodeContext -> DecodeContext
forall a. Semigroup a => a -> a -> a
<> [ContextItem
p])

{--- Decoding ---}

-- | Decode the given TOML input.
decode :: DecodeTOML a => Text -> Either TOMLError a
decode :: Text -> Either TOMLError a
decode = Decoder a -> Text -> Either TOMLError a
forall a. Decoder a -> Text -> Either TOMLError a
decodeWith Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

-- | Decode the given TOML input using the given 'Decoder'.
decodeWith :: Decoder a -> Text -> Either TOMLError a
decodeWith :: Decoder a -> Text -> Either TOMLError a
decodeWith Decoder a
decoder = Decoder a -> String -> Text -> Either TOMLError a
forall a. Decoder a -> String -> Text -> Either TOMLError a
decodeWithOpts Decoder a
decoder String
""

decodeWithOpts :: Decoder a -> String -> Text -> Either TOMLError a
decodeWithOpts :: Decoder a -> String -> Text -> Either TOMLError a
decodeWithOpts Decoder a
decoder String
filename Text
input = do
  Value
v <- String -> Text -> Either TOMLError Value
parseTOML String
filename Text
input
  ((DecodeContext, DecodeError) -> TOMLError)
-> Either (DecodeContext, DecodeError) a -> Either TOMLError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((DecodeContext -> DecodeError -> TOMLError)
-> (DecodeContext, DecodeError) -> TOMLError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DecodeContext -> DecodeError -> TOMLError
DecodeError) (Either (DecodeContext, DecodeError) a -> Either TOMLError a)
-> Either (DecodeContext, DecodeError) a -> Either TOMLError a
forall a b. (a -> b) -> a -> b
$ Decoder a
-> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a
forall a.
Decoder a
-> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a
decoderToEither Decoder a
decoder Value
v []

-- | Decode a TOML file at the given file path.
decodeFile :: DecodeTOML a => FilePath -> IO (Either TOMLError a)
decodeFile :: String -> IO (Either TOMLError a)
decodeFile String
fp = Decoder a -> String -> Text -> Either TOMLError a
forall a. Decoder a -> String -> Text -> Either TOMLError a
decodeWithOpts Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder String
fp (Text -> Either TOMLError a) -> IO Text -> IO (Either TOMLError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
Text.readFile String
fp

{--- Decoder helpers ---}

{- |
Decode a field in a TOML Value.
Equivalent to 'getFields' with a single-element list.

@
a = 1
b = 'asdf'
@

@
-- MyConfig 1 "asdf"
MyConfig \<$> getField "a" \<*> getField "b"
@
-}
getField :: DecodeTOML a => Text -> Decoder a
getField :: Text -> Decoder a
getField = Decoder a -> Text -> Decoder a
forall a. Decoder a -> Text -> Decoder a
getFieldWith Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

-- | Same as 'getField', except with the given 'Decoder'.
getFieldWith :: Decoder a -> Text -> Decoder a
getFieldWith :: Decoder a -> Text -> Decoder a
getFieldWith Decoder a
decoder Text
key = Decoder a -> [Text] -> Decoder a
forall a. Decoder a -> [Text] -> Decoder a
getFieldsWith Decoder a
decoder [Text
key]

{- |
Decode a field in a TOML Value, or Nothing if the field doesn't exist.
Equivalent to 'getFieldsOpt' with a single-element list.

@
a = 1
@

@
-- MyConfig (Just 1) Nothing
MyConfig \<$> getFieldOpt "a" \<*> getFieldOpt "b"
@
-}
getFieldOpt :: DecodeTOML a => Text -> Decoder (Maybe a)
getFieldOpt :: Text -> Decoder (Maybe a)
getFieldOpt = Decoder a -> Text -> Decoder (Maybe a)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

-- | Same as 'getFieldOpt', except with the given 'Decoder'.
getFieldOptWith :: Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith :: Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder a
decoder Text
key = Decoder a -> [Text] -> Decoder (Maybe a)
forall a. Decoder a -> [Text] -> Decoder (Maybe a)
getFieldsOptWith Decoder a
decoder [Text
key]

{- |
Decode a nested field in a TOML Value.

@
a.b = 1
@

@
-- MyConfig 1
MyConfig \<$> getFields ["a", "b"]
@
-}
getFields :: DecodeTOML a => [Text] -> Decoder a
getFields :: [Text] -> Decoder a
getFields = Decoder a -> [Text] -> Decoder a
forall a. Decoder a -> [Text] -> Decoder a
getFieldsWith Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

-- | Same as 'getFields', except with the given 'Decoder'.
getFieldsWith :: Decoder a -> [Text] -> Decoder a
getFieldsWith :: Decoder a -> [Text] -> Decoder a
getFieldsWith Decoder a
decoder = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM a) -> Decoder a)
-> ([Text] -> Value -> DecodeM a) -> [Text] -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Value -> DecodeM a
go
  where
    go :: [Text] -> Value -> DecodeM a
go [] Value
v = Decoder a -> Value -> DecodeM a
forall a. Decoder a -> Value -> DecodeM a
runDecoder Decoder a
decoder Value
v
    go (Text
k : [Text]
ks) Value
v =
      case Value
v of
        Table Table
o ->
          ContextItem -> DecodeM a -> DecodeM a
forall a. ContextItem -> DecodeM a -> DecodeM a
addContextItem (Text -> ContextItem
Key Text
k) (DecodeM a -> DecodeM a) -> DecodeM a -> DecodeM a
forall a b. (a -> b) -> a -> b
$
            case Text -> Table -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Table
o of
              Just Value
v' -> [Text] -> Value -> DecodeM a
go [Text]
ks Value
v'
              Maybe Value
Nothing -> DecodeError -> DecodeM a
forall a. DecodeError -> DecodeM a
decodeError DecodeError
MissingField
        Value
_ -> Value -> DecodeM a
forall a. Value -> DecodeM a
typeMismatch Value
v

{- |
Decode a nested field in a TOML Value, or 'Nothing' if any of the fields don't exist.

@
a.b = 1
@

@
-- MyConfig (Just 1) Nothing Nothing
MyConfig
  \<$> getFieldsOpt ["a", "b"]
  \<*> getFieldsOpt ["a", "c"]
  \<*> getFieldsOpt ["b", "c"]
@
-}
getFieldsOpt :: DecodeTOML a => [Text] -> Decoder (Maybe a)
getFieldsOpt :: [Text] -> Decoder (Maybe a)
getFieldsOpt = Decoder a -> [Text] -> Decoder (Maybe a)
forall a. Decoder a -> [Text] -> Decoder (Maybe a)
getFieldsOptWith Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

-- | Same as 'getFieldsOpt', except with the given 'Decoder'.
getFieldsOptWith :: Decoder a -> [Text] -> Decoder (Maybe a)
getFieldsOptWith :: Decoder a -> [Text] -> Decoder (Maybe a)
getFieldsOptWith Decoder a
decoder [Text]
keys =
  (Value -> DecodeM (Maybe a)) -> Decoder (Maybe a)
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM (Maybe a)) -> Decoder (Maybe a))
-> (Value -> DecodeM (Maybe a)) -> Decoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Value
v ->
    (DecodeContext -> Either (DecodeContext, DecodeError) (Maybe a))
-> DecodeM (Maybe a)
forall a.
(DecodeContext -> Either (DecodeContext, DecodeError) a)
-> DecodeM a
DecodeM ((DecodeContext -> Either (DecodeContext, DecodeError) (Maybe a))
 -> DecodeM (Maybe a))
-> (DecodeContext -> Either (DecodeContext, DecodeError) (Maybe a))
-> DecodeM (Maybe a)
forall a b. (a -> b) -> a -> b
$ \DecodeContext
ctx ->
      case (DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
forall a.
DecodeM a -> DecodeContext -> Either (DecodeContext, DecodeError) a
`unDecodeM` DecodeContext
ctx) (DecodeM a -> Either (DecodeContext, DecodeError) a)
-> (Decoder a -> DecodeM a)
-> Decoder a
-> Either (DecodeContext, DecodeError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decoder a -> Value -> DecodeM a
forall a. Decoder a -> Value -> DecodeM a
`runDecoder` Value
v) (Decoder a -> Either (DecodeContext, DecodeError) a)
-> Decoder a -> Either (DecodeContext, DecodeError) a
forall a b. (a -> b) -> a -> b
$ Decoder a -> [Text] -> Decoder a
forall a. Decoder a -> [Text] -> Decoder a
getFieldsWith Decoder a
decoder [Text]
keys of
        Left (DecodeContext
_, DecodeError
MissingField) -> Maybe a -> Either (DecodeContext, DecodeError) (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
        Left (DecodeContext
ctx', DecodeError
e) -> (DecodeContext, DecodeError)
-> Either (DecodeContext, DecodeError) (Maybe a)
forall a b. a -> Either a b
Left (DecodeContext
ctx', DecodeError
e)
        Right a
x -> Maybe a -> Either (DecodeContext, DecodeError) (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either (DecodeContext, DecodeError) (Maybe a))
-> Maybe a -> Either (DecodeContext, DecodeError) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x

{- |
Decode a list of values using the given 'Decoder'.

@
[[a]]
b = 1

[[a]]
b = 2
@

@
-- MyConfig [1, 2]
MyConfig
  \<$> getFieldWith (getArrayOf (getField "b")) "a"
@
-}
getArrayOf :: Decoder a -> Decoder [a]
getArrayOf :: Decoder a -> Decoder [a]
getArrayOf Decoder a
decoder =
  (Value -> DecodeM [a]) -> Decoder [a]
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM [a]) -> Decoder [a])
-> (Value -> DecodeM [a]) -> Decoder [a]
forall a b. (a -> b) -> a -> b
$ \case
    Array [Value]
vs -> (Int -> Value -> DecodeM a) -> [Int] -> [Value] -> DecodeM [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i -> ContextItem -> DecodeM a -> DecodeM a
forall a. ContextItem -> DecodeM a -> DecodeM a
addContextItem (Int -> ContextItem
Index Int
i) (DecodeM a -> DecodeM a)
-> (Value -> DecodeM a) -> Value -> DecodeM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Value -> DecodeM a
forall a. Decoder a -> Value -> DecodeM a
runDecoder Decoder a
decoder) [Int
0 ..] [Value]
vs
    Value
v -> Value -> DecodeM [a]
forall a. Value -> DecodeM a
typeMismatch Value
v

{--- DecodeTOML ---}

{- |
A type class containing the default 'Decoder' for the given type.

See the docs for 'Decoder' for examples.
-}
class DecodeTOML a where
  tomlDecoder :: Decoder a

instance DecodeTOML Value where
  tomlDecoder :: Decoder Value
tomlDecoder = (Value -> DecodeM Value) -> Decoder Value
forall a. (Value -> DecodeM a) -> Decoder a
Decoder Value -> DecodeM Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance DecodeTOML Void where
  tomlDecoder :: Decoder Void
tomlDecoder = (Value -> DecodeM Void) -> Decoder Void
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder Value -> DecodeM Void
forall a. Value -> DecodeM a
typeMismatch
instance DecodeTOML Bool where
  tomlDecoder :: Decoder Bool
tomlDecoder =
    (Value -> DecodeM Bool) -> Decoder Bool
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Bool) -> Decoder Bool)
-> (Value -> DecodeM Bool) -> Decoder Bool
forall a b. (a -> b) -> a -> b
$ \case
      Boolean Bool
x -> Bool -> DecodeM Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x
      Value
v -> Value -> DecodeM Bool
forall a. Value -> DecodeM a
typeMismatch Value
v

instance DecodeTOML Integer where
  tomlDecoder :: Decoder Integer
tomlDecoder =
    (Value -> DecodeM Integer) -> Decoder Integer
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Integer) -> Decoder Integer)
-> (Value -> DecodeM Integer) -> Decoder Integer
forall a b. (a -> b) -> a -> b
$ \case
      Integer Integer
x -> Integer -> DecodeM Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
      Value
v -> Value -> DecodeM Integer
forall a. Value -> DecodeM a
typeMismatch Value
v

tomlDecoderInt :: forall a. Num a => Decoder a
tomlDecoderInt :: Decoder a
tomlDecoderInt = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Decoder Integer -> Decoder a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Integer
forall a. DecodeTOML a => Decoder a
tomlDecoder

tomlDecoderBoundedInt :: forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt :: Decoder a
tomlDecoderBoundedInt =
  Decoder Integer
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Integer -> (Integer -> Decoder a) -> Decoder a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Integer
x
      | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded a => a
forall a. Bounded a => a
minBound @a) -> (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM a
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Underflow"
      | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded a => a
forall a. Bounded a => a
maxBound @a) -> (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM a
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Overflow"
      | Bool
otherwise -> a -> Decoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Decoder a) -> a -> Decoder a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x

instance DecodeTOML Int where
  tomlDecoder :: Decoder Int
tomlDecoder = Decoder Int
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Int8 where
  tomlDecoder :: Decoder Int8
tomlDecoder = Decoder Int8
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Int16 where
  tomlDecoder :: Decoder Int16
tomlDecoder = Decoder Int16
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Int32 where
  tomlDecoder :: Decoder Int32
tomlDecoder = Decoder Int32
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Int64 where
  tomlDecoder :: Decoder Int64
tomlDecoder = Decoder Int64
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Word where
  tomlDecoder :: Decoder Word
tomlDecoder = Decoder Word
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Word8 where
  tomlDecoder :: Decoder Word8
tomlDecoder = Decoder Word8
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Word16 where
  tomlDecoder :: Decoder Word16
tomlDecoder = Decoder Word16
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Word32 where
  tomlDecoder :: Decoder Word32
tomlDecoder = Decoder Word32
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Word64 where
  tomlDecoder :: Decoder Word64
tomlDecoder = Decoder Word64
forall a. (Integral a, Bounded a) => Decoder a
tomlDecoderBoundedInt
instance DecodeTOML Natural where
  tomlDecoder :: Decoder Natural
tomlDecoder =
    Decoder Integer
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Integer -> (Integer -> Decoder Natural) -> Decoder Natural
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Integer
x
        | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> Natural -> Decoder Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Decoder Natural) -> Natural -> Decoder Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
x
        | Bool
otherwise -> (Value -> DecodeM Natural) -> Decoder Natural
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Natural) -> Decoder Natural)
-> (Value -> DecodeM Natural) -> Decoder Natural
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM Natural
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Got negative number"

instance DecodeTOML Double where
  tomlDecoder :: Decoder Double
tomlDecoder =
    (Value -> DecodeM Double) -> Decoder Double
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Double) -> Decoder Double)
-> (Value -> DecodeM Double) -> Decoder Double
forall a b. (a -> b) -> a -> b
$ \case
      Float Double
x -> Double -> DecodeM Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
      Value
v -> Value -> DecodeM Double
forall a. Value -> DecodeM a
typeMismatch Value
v

tomlDecoderFrac :: Fractional a => Decoder a
tomlDecoderFrac :: Decoder a
tomlDecoderFrac = Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> a) -> Decoder Double -> Decoder a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeTOML Double => Decoder Double
forall a. DecodeTOML a => Decoder a
tomlDecoder @Double

instance DecodeTOML Float where
  tomlDecoder :: Decoder Float
tomlDecoder = Decoder Float
forall a. Fractional a => Decoder a
tomlDecoderFrac
instance Integral a => DecodeTOML (Ratio a) where
  tomlDecoder :: Decoder (Ratio a)
tomlDecoder = Decoder (Ratio a)
forall a. Fractional a => Decoder a
tomlDecoderFrac
instance HasResolution a => DecodeTOML (Fixed a) where
  tomlDecoder :: Decoder (Fixed a)
tomlDecoder = Decoder (Fixed a)
forall a. Fractional a => Decoder a
tomlDecoderFrac

instance DecodeTOML Char where
  tomlDecoder :: Decoder Char
tomlDecoder =
    Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text -> (Text -> Decoder Char) -> Decoder Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Text
s
        | Text -> Int
Text.length Text
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Char -> Decoder Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Decoder Char) -> Char -> Decoder Char
forall a b. (a -> b) -> a -> b
$ Text -> Char
Text.head Text
s
        | Bool
otherwise -> (Value -> DecodeM Char) -> Decoder Char
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Char) -> Decoder Char)
-> (Value -> DecodeM Char) -> Decoder Char
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM Char
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Expected single character string"
instance {-# OVERLAPPING #-} DecodeTOML String where
  tomlDecoder :: Decoder String
tomlDecoder = Text -> String
Text.unpack (Text -> String) -> Decoder Text -> Decoder String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML Text where
  tomlDecoder :: Decoder Text
tomlDecoder =
    (Value -> DecodeM Text) -> Decoder Text
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Text) -> Decoder Text)
-> (Value -> DecodeM Text) -> Decoder Text
forall a b. (a -> b) -> a -> b
$ \case
      String Text
s -> Text -> DecodeM Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
      Value
v -> Value -> DecodeM Text
forall a. Value -> DecodeM a
typeMismatch Value
v
instance DecodeTOML Lazy.Text where
  tomlDecoder :: Decoder Text
tomlDecoder = Text -> Text
Text.Lazy.fromStrict (Text -> Text) -> Decoder Text -> Decoder Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder

instance DecodeTOML Time.ZonedTime where
  tomlDecoder :: Decoder ZonedTime
tomlDecoder =
    (Value -> DecodeM ZonedTime) -> Decoder ZonedTime
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM ZonedTime) -> Decoder ZonedTime)
-> (Value -> DecodeM ZonedTime) -> Decoder ZonedTime
forall a b. (a -> b) -> a -> b
$ \case
      OffsetDateTime (LocalTime
lt, TimeZone
tz) -> ZonedTime -> DecodeM ZonedTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonedTime -> DecodeM ZonedTime) -> ZonedTime -> DecodeM ZonedTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
Time.ZonedTime LocalTime
lt TimeZone
tz
      Value
v -> Value -> DecodeM ZonedTime
forall a. Value -> DecodeM a
typeMismatch Value
v
instance DecodeTOML Time.UTCTime where
  tomlDecoder :: Decoder UTCTime
tomlDecoder = ZonedTime -> UTCTime
Time.zonedTimeToUTC (ZonedTime -> UTCTime) -> Decoder ZonedTime -> Decoder UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder ZonedTime
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML Time.SystemTime where
  tomlDecoder :: Decoder SystemTime
tomlDecoder = UTCTime -> SystemTime
Time.utcToSystemTime (UTCTime -> SystemTime)
-> (ZonedTime -> UTCTime) -> ZonedTime -> SystemTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
Time.zonedTimeToUTC (ZonedTime -> SystemTime)
-> Decoder ZonedTime -> Decoder SystemTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder ZonedTime
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML Time.LocalTime where
  tomlDecoder :: Decoder LocalTime
tomlDecoder =
    (Value -> DecodeM LocalTime) -> Decoder LocalTime
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM LocalTime) -> Decoder LocalTime)
-> (Value -> DecodeM LocalTime) -> Decoder LocalTime
forall a b. (a -> b) -> a -> b
$ \case
      LocalDateTime LocalTime
dt -> LocalTime -> DecodeM LocalTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
dt
      Value
v -> Value -> DecodeM LocalTime
forall a. Value -> DecodeM a
typeMismatch Value
v
instance DecodeTOML Time.Day where
  tomlDecoder :: Decoder Day
tomlDecoder =
    (Value -> DecodeM Day) -> Decoder Day
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Day) -> Decoder Day)
-> (Value -> DecodeM Day) -> Decoder Day
forall a b. (a -> b) -> a -> b
$ \case
      LocalDate Day
d -> Day -> DecodeM Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
d
      Value
v -> Value -> DecodeM Day
forall a. Value -> DecodeM a
typeMismatch Value
v
instance DecodeTOML Time.TimeOfDay where
  tomlDecoder :: Decoder TimeOfDay
tomlDecoder =
    (Value -> DecodeM TimeOfDay) -> Decoder TimeOfDay
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM TimeOfDay) -> Decoder TimeOfDay)
-> (Value -> DecodeM TimeOfDay) -> Decoder TimeOfDay
forall a b. (a -> b) -> a -> b
$ \case
      LocalTime TimeOfDay
t -> TimeOfDay -> DecodeM TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
t
      Value
v -> Value -> DecodeM TimeOfDay
forall a. Value -> DecodeM a
typeMismatch Value
v
#if MIN_VERSION_time(1,9,0)
instance DecodeTOML Time.DayOfWeek where
  tomlDecoder :: Decoder DayOfWeek
tomlDecoder = Text -> Decoder DayOfWeek
toDayOfWeek (Text -> Decoder DayOfWeek)
-> (Text -> Text) -> Text -> Decoder DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower (Text -> Decoder DayOfWeek) -> Decoder Text -> Decoder DayOfWeek
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder
    where
      toDayOfWeek :: Text -> Decoder DayOfWeek
toDayOfWeek = \case
        Text
"monday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Monday
        Text
"tuesday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Tuesday
        Text
"wednesday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Wednesday
        Text
"thursday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Thursday
        Text
"friday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Friday
        Text
"saturday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Saturday
        Text
"sunday" -> DayOfWeek -> Decoder DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Sunday
        Text
_ -> (Value -> DecodeM DayOfWeek) -> Decoder DayOfWeek
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM DayOfWeek) -> Decoder DayOfWeek)
-> (Value -> DecodeM DayOfWeek) -> Decoder DayOfWeek
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM DayOfWeek
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Invalid day of week"
#endif

instance DecodeTOML Time.DiffTime where
  tomlDecoder :: Decoder DiffTime
tomlDecoder = Decoder DiffTime
forall a. Num a => Decoder a
tomlDecoderInt Decoder DiffTime -> Decoder DiffTime -> Decoder DiffTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Decoder DiffTime
forall a. Fractional a => Decoder a
tomlDecoderFrac
instance DecodeTOML Time.NominalDiffTime where
  tomlDecoder :: Decoder NominalDiffTime
tomlDecoder = Decoder NominalDiffTime
forall a. Num a => Decoder a
tomlDecoderInt Decoder NominalDiffTime
-> Decoder NominalDiffTime -> Decoder NominalDiffTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Decoder NominalDiffTime
forall a. Fractional a => Decoder a
tomlDecoderFrac
#if MIN_VERSION_time(1,9,0)
instance DecodeTOML Time.CalendarDiffTime where
  tomlDecoder :: Decoder CalendarDiffTime
tomlDecoder =
    Integer -> NominalDiffTime -> CalendarDiffTime
Time.CalendarDiffTime
      (Integer -> NominalDiffTime -> CalendarDiffTime)
-> Decoder Integer -> Decoder (NominalDiffTime -> CalendarDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Integer
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"months"
      Decoder (NominalDiffTime -> CalendarDiffTime)
-> Decoder NominalDiffTime -> Decoder CalendarDiffTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Decoder NominalDiffTime
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"time"
instance DecodeTOML Time.CalendarDiffDays where
  tomlDecoder :: Decoder CalendarDiffDays
tomlDecoder =
    Integer -> Integer -> CalendarDiffDays
Time.CalendarDiffDays
      (Integer -> Integer -> CalendarDiffDays)
-> Decoder Integer -> Decoder (Integer -> CalendarDiffDays)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Integer
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"months"
      Decoder (Integer -> CalendarDiffDays)
-> Decoder Integer -> Decoder CalendarDiffDays
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Decoder Integer
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"days"
#endif

instance DecodeTOML Version where
  tomlDecoder :: Decoder Version
tomlDecoder = [(Version, String)] -> Decoder Version
forall a a. [(a, [a])] -> Decoder a
go ([(Version, String)] -> Decoder Version)
-> (String -> [(Version, String)]) -> String -> Decoder Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Version -> String -> [(Version, String)]
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion (String -> Decoder Version) -> Decoder String -> Decoder Version
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder String
forall a. DecodeTOML a => Decoder a
tomlDecoder
    where
      go :: [(a, [a])] -> Decoder a
go ((a
v, []) : [(a, [a])]
_) = a -> Decoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
      go ((a, [a])
_ : [(a, [a])]
vs) = [(a, [a])] -> Decoder a
go [(a, [a])]
vs
      go [] = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM a
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Invalid Version"
instance DecodeTOML Ordering where
  tomlDecoder :: Decoder Ordering
tomlDecoder =
    DecodeTOML Text => Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder @Text Decoder Text -> (Text -> Decoder Ordering) -> Decoder Ordering
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Text
"LT" -> Ordering -> Decoder Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
      Text
"EQ" -> Ordering -> Decoder Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
      Text
"GT" -> Ordering -> Decoder Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
      Text
_ -> (Value -> DecodeM Ordering) -> Decoder Ordering
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM Ordering) -> Decoder Ordering)
-> (Value -> DecodeM Ordering) -> Decoder Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM Ordering
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Invalid Ordering"

instance DecodeTOML a => DecodeTOML (Identity a) where
  tomlDecoder :: Decoder (Identity a)
tomlDecoder = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Decoder a -> Decoder (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML (Proxy a) where
  tomlDecoder :: Decoder (Proxy a)
tomlDecoder = Proxy a -> Decoder (Proxy a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Proxy a
forall k (t :: k). Proxy t
Proxy
instance DecodeTOML a => DecodeTOML (Const a b) where
  tomlDecoder :: Decoder (Const a b)
tomlDecoder = a -> Const a b
forall k a (b :: k). a -> Const a b
Const (a -> Const a b) -> Decoder a -> Decoder (Const a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

{- |
Since TOML doesn't support literal NULLs, this will only ever return 'Just'.
To get the absence of a field, use 'getFieldOpt' or one of its variants.
-}
instance DecodeTOML a => DecodeTOML (Maybe a) where
  tomlDecoder :: Decoder (Maybe a)
tomlDecoder = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Decoder a -> Decoder (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

instance (DecodeTOML a, DecodeTOML b) => DecodeTOML (Either a b) where
  tomlDecoder :: Decoder (Either a b)
tomlDecoder = (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Decoder b -> Decoder (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder b
forall a. DecodeTOML a => Decoder a
tomlDecoder) Decoder (Either a b)
-> Decoder (Either a b) -> Decoder (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Decoder a -> Decoder (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder)

instance DecodeTOML a => DecodeTOML (Monoid.First a) where
  tomlDecoder :: Decoder (First a)
tomlDecoder = Maybe a -> First a
forall a. Maybe a -> First a
Monoid.First (Maybe a -> First a) -> Decoder (Maybe a) -> Decoder (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Maybe a)
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Monoid.Last a) where
  tomlDecoder :: Decoder (Last a)
tomlDecoder = Maybe a -> Last a
forall a. Maybe a -> Last a
Monoid.Last (Maybe a -> Last a) -> Decoder (Maybe a) -> Decoder (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Maybe a)
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Semigroup.First a) where
  tomlDecoder :: Decoder (First a)
tomlDecoder = a -> First a
forall a. a -> First a
Semigroup.First (a -> First a) -> Decoder a -> Decoder (First a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Semigroup.Last a) where
  tomlDecoder :: Decoder (Last a)
tomlDecoder = a -> Last a
forall a. a -> Last a
Semigroup.Last (a -> Last a) -> Decoder a -> Decoder (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Semigroup.Max a) where
  tomlDecoder :: Decoder (Max a)
tomlDecoder = a -> Max a
forall a. a -> Max a
Semigroup.Max (a -> Max a) -> Decoder a -> Decoder (Max a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Semigroup.Min a) where
  tomlDecoder :: Decoder (Min a)
tomlDecoder = a -> Min a
forall a. a -> Min a
Semigroup.Min (a -> Min a) -> Decoder a -> Decoder (Min a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Monoid.Dual a) where
  tomlDecoder :: Decoder (Dual a)
tomlDecoder = a -> Dual a
forall a. a -> Dual a
Monoid.Dual (a -> Dual a) -> Decoder a -> Decoder (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder

instance DecodeTOML a => DecodeTOML [a] where
  tomlDecoder :: Decoder [a]
tomlDecoder = Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
getArrayOf Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance (IsString k, Ord k, DecodeTOML v) => DecodeTOML (Map k v) where
  tomlDecoder :: Decoder (Map k v)
tomlDecoder =
    (Value -> DecodeM (Map k v)) -> Decoder (Map k v)
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM (Map k v)) -> Decoder (Map k v))
-> (Value -> DecodeM (Map k v)) -> Decoder (Map k v)
forall a b. (a -> b) -> a -> b
$ \case
      Table Table
o -> (Text -> k) -> Map Text v -> Map k v
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (String -> k
forall a. IsString a => String -> a
fromString (String -> k) -> (Text -> String) -> Text -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (Map Text v -> Map k v)
-> DecodeM (Map Text v) -> DecodeM (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> DecodeM v) -> Table -> DecodeM (Map Text v)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Decoder v -> Value -> DecodeM v
forall a. Decoder a -> Value -> DecodeM a
runDecoder Decoder v
forall a. DecodeTOML a => Decoder a
tomlDecoder) Table
o
      Value
v -> Value -> DecodeM (Map k v)
forall a. Value -> DecodeM a
typeMismatch Value
v
instance DecodeTOML a => DecodeTOML (NonEmpty a) where
  tomlDecoder :: Decoder (NonEmpty a)
tomlDecoder = Decoder (NonEmpty a)
-> (NonEmpty a -> Decoder (NonEmpty a))
-> Maybe (NonEmpty a)
-> Decoder (NonEmpty a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Decoder (NonEmpty a)
forall a. Decoder a
raiseEmpty NonEmpty a -> Decoder (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty a) -> Decoder (NonEmpty a))
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> Decoder (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([a] -> Decoder (NonEmpty a))
-> Decoder [a] -> Decoder (NonEmpty a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder [a]
forall a. DecodeTOML a => Decoder a
tomlDecoder
    where
      raiseEmpty :: Decoder a
raiseEmpty = (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ Text -> Value -> DecodeM a
forall a. Text -> Value -> DecodeM a
invalidValue Text
"Got empty list"
instance DecodeTOML IntSet where
  tomlDecoder :: Decoder IntSet
tomlDecoder = [Int] -> IntSet
IntSet.fromList ([Int] -> IntSet) -> Decoder [Int] -> Decoder IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [Int]
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance (DecodeTOML a, Ord a) => DecodeTOML (Set a) where
  tomlDecoder :: Decoder (Set a)
tomlDecoder = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Decoder [a] -> Decoder (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [a]
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (IntMap a) where
  tomlDecoder :: Decoder (IntMap a)
tomlDecoder = [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, a)] -> IntMap a)
-> Decoder [(Int, a)] -> Decoder (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [(Int, a)]
forall a. DecodeTOML a => Decoder a
tomlDecoder
instance DecodeTOML a => DecodeTOML (Seq a) where
  tomlDecoder :: Decoder (Seq a)
tomlDecoder = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Decoder [a] -> Decoder (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [a]
forall a. DecodeTOML a => Decoder a
tomlDecoder

tomlDecoderTuple :: ([Value] -> Maybe (DecodeM a)) -> Decoder a
tomlDecoderTuple :: ([Value] -> Maybe (DecodeM a)) -> Decoder a
tomlDecoderTuple [Value] -> Maybe (DecodeM a)
f =
  (Value -> DecodeM a) -> Decoder a
forall a. (Value -> DecodeM a) -> Decoder a
makeDecoder ((Value -> DecodeM a) -> Decoder a)
-> (Value -> DecodeM a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \case
    Array [Value]
vs | Just DecodeM a
decodeM <- [Value] -> Maybe (DecodeM a)
f [Value]
vs -> DecodeM a
decodeM
    Value
v -> Value -> DecodeM a
forall a. Value -> DecodeM a
typeMismatch Value
v
decodeElem :: DecodeTOML a => Int -> Value -> DecodeM a
decodeElem :: Int -> Value -> DecodeM a
decodeElem Int
i Value
v = ContextItem -> DecodeM a -> DecodeM a
forall a. ContextItem -> DecodeM a -> DecodeM a
addContextItem (Int -> ContextItem
Index Int
i) (Decoder a -> Value -> DecodeM a
forall a. Decoder a -> Value -> DecodeM a
runDecoder Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder Value
v)
instance DecodeTOML () where
  tomlDecoder :: Decoder ()
tomlDecoder = ([Value] -> Maybe (DecodeM ())) -> Decoder ()
forall a. ([Value] -> Maybe (DecodeM a)) -> Decoder a
tomlDecoderTuple (([Value] -> Maybe (DecodeM ())) -> Decoder ())
-> ([Value] -> Maybe (DecodeM ())) -> Decoder ()
forall a b. (a -> b) -> a -> b
$ \case
    [] -> DecodeM () -> Maybe (DecodeM ())
forall a. a -> Maybe a
Just (DecodeM () -> Maybe (DecodeM ()))
-> DecodeM () -> Maybe (DecodeM ())
forall a b. (a -> b) -> a -> b
$ () -> DecodeM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [Value]
_ -> Maybe (DecodeM ())
forall a. Maybe a
Nothing
instance (DecodeTOML a, DecodeTOML b) => DecodeTOML (a, b) where
  tomlDecoder :: Decoder (a, b)
tomlDecoder = ([Value] -> Maybe (DecodeM (a, b))) -> Decoder (a, b)
forall a. ([Value] -> Maybe (DecodeM a)) -> Decoder a
tomlDecoderTuple (([Value] -> Maybe (DecodeM (a, b))) -> Decoder (a, b))
-> ([Value] -> Maybe (DecodeM (a, b))) -> Decoder (a, b)
forall a b. (a -> b) -> a -> b
$ \case
    [Value
a, Value
b] ->
      DecodeM (a, b) -> Maybe (DecodeM (a, b))
forall a. a -> Maybe a
Just (DecodeM (a, b) -> Maybe (DecodeM (a, b)))
-> DecodeM (a, b) -> Maybe (DecodeM (a, b))
forall a b. (a -> b) -> a -> b
$
        (,)
          (a -> b -> (a, b)) -> DecodeM a -> DecodeM (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Value -> DecodeM a
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
0 Value
a
          DecodeM (b -> (a, b)) -> DecodeM b -> DecodeM (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Value -> DecodeM b
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
1 Value
b
    [Value]
_ -> Maybe (DecodeM (a, b))
forall a. Maybe a
Nothing
instance (DecodeTOML a, DecodeTOML b, DecodeTOML c) => DecodeTOML (a, b, c) where
  tomlDecoder :: Decoder (a, b, c)
tomlDecoder = ([Value] -> Maybe (DecodeM (a, b, c))) -> Decoder (a, b, c)
forall a. ([Value] -> Maybe (DecodeM a)) -> Decoder a
tomlDecoderTuple (([Value] -> Maybe (DecodeM (a, b, c))) -> Decoder (a, b, c))
-> ([Value] -> Maybe (DecodeM (a, b, c))) -> Decoder (a, b, c)
forall a b. (a -> b) -> a -> b
$ \case
    [Value
a, Value
b, Value
c] ->
      DecodeM (a, b, c) -> Maybe (DecodeM (a, b, c))
forall a. a -> Maybe a
Just (DecodeM (a, b, c) -> Maybe (DecodeM (a, b, c)))
-> DecodeM (a, b, c) -> Maybe (DecodeM (a, b, c))
forall a b. (a -> b) -> a -> b
$
        (,,)
          (a -> b -> c -> (a, b, c))
-> DecodeM a -> DecodeM (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Value -> DecodeM a
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
0 Value
a
          DecodeM (b -> c -> (a, b, c))
-> DecodeM b -> DecodeM (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Value -> DecodeM b
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
1 Value
b
          DecodeM (c -> (a, b, c)) -> DecodeM c -> DecodeM (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Value -> DecodeM c
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
2 Value
c
    [Value]
_ -> Maybe (DecodeM (a, b, c))
forall a. Maybe a
Nothing
instance (DecodeTOML a, DecodeTOML b, DecodeTOML c, DecodeTOML d) => DecodeTOML (a, b, c, d) where
  tomlDecoder :: Decoder (a, b, c, d)
tomlDecoder = ([Value] -> Maybe (DecodeM (a, b, c, d))) -> Decoder (a, b, c, d)
forall a. ([Value] -> Maybe (DecodeM a)) -> Decoder a
tomlDecoderTuple (([Value] -> Maybe (DecodeM (a, b, c, d))) -> Decoder (a, b, c, d))
-> ([Value] -> Maybe (DecodeM (a, b, c, d)))
-> Decoder (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \case
    [Value
a, Value
b, Value
c, Value
d] ->
      DecodeM (a, b, c, d) -> Maybe (DecodeM (a, b, c, d))
forall a. a -> Maybe a
Just (DecodeM (a, b, c, d) -> Maybe (DecodeM (a, b, c, d)))
-> DecodeM (a, b, c, d) -> Maybe (DecodeM (a, b, c, d))
forall a b. (a -> b) -> a -> b
$
        (,,,)
          (a -> b -> c -> d -> (a, b, c, d))
-> DecodeM a -> DecodeM (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Value -> DecodeM a
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
0 Value
a
          DecodeM (b -> c -> d -> (a, b, c, d))
-> DecodeM b -> DecodeM (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Value -> DecodeM b
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
1 Value
b
          DecodeM (c -> d -> (a, b, c, d))
-> DecodeM c -> DecodeM (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Value -> DecodeM c
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
2 Value
c
          DecodeM (d -> (a, b, c, d)) -> DecodeM d -> DecodeM (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Value -> DecodeM d
forall a. DecodeTOML a => Int -> Value -> DecodeM a
decodeElem Int
3 Value
d
    [Value]
_ -> Maybe (DecodeM (a, b, c, d))
forall a. Maybe a
Nothing