----------------------------------------------------------------------------
-- |
-- Module      :  Data.Toml.Parse
-- Copyright   :  (c) Sergey Vinokurov 2018
-- License     :  Apache-2.0 (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
----------------------------------------------------------------------------

{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost        #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}

module Data.Toml.Parse
  ( Node(..)
  , Parser
  , runParser
  , mkTomlError
  , AtomicTomlError(..)
  , TomlError
  , (<?>)
  , L
  , extract
  , TomlParse(..)
  , FromToml(..)
  , Index(..)
  , (.!=)
  , pTable
  , pKey
  , pKeyMaybe
  , pStr
  , pStrL
  , pBool
  , pInt
  , pIntL
  , pDouble
  , pDoubleL
  , pDatetime
  , pDatetimeL
  , pTArray
  , pArray
  , pCases

  , ppToml
  ) where

import Control.Applicative
import Control.Comonad
import Control.Monad.Except

import Data.Bifunctor
import Data.DList (DList)
import Data.DList qualified as DL
import Data.Foldable
import Data.HashMap.Strict qualified as HM
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (UTCTime)
import Data.Time.Format.ISO8601
import Data.Traversable
import Data.Vector (Vector)
import Data.Vector qualified as V
import Data.Void (Void, vacuous)
import Prettyprinter
import Prettyprinter.Combinators
import Prettyprinter.Generics
import Text.Toml

import Unsafe.Coerce

data TomlType
  = TTable
  | TTArray
  | TString
  | TInteger
  | TFloat
  | TBoolean
  | TDatetime
  | TArray
  deriving (TomlType -> TomlType -> Bool
(TomlType -> TomlType -> Bool)
-> (TomlType -> TomlType -> Bool) -> Eq TomlType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlType -> TomlType -> Bool
$c/= :: TomlType -> TomlType -> Bool
== :: TomlType -> TomlType -> Bool
$c== :: TomlType -> TomlType -> Bool
Eq, Eq TomlType
Eq TomlType
-> (TomlType -> TomlType -> Ordering)
-> (TomlType -> TomlType -> Bool)
-> (TomlType -> TomlType -> Bool)
-> (TomlType -> TomlType -> Bool)
-> (TomlType -> TomlType -> Bool)
-> (TomlType -> TomlType -> TomlType)
-> (TomlType -> TomlType -> TomlType)
-> Ord TomlType
TomlType -> TomlType -> Bool
TomlType -> TomlType -> Ordering
TomlType -> TomlType -> TomlType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TomlType -> TomlType -> TomlType
$cmin :: TomlType -> TomlType -> TomlType
max :: TomlType -> TomlType -> TomlType
$cmax :: TomlType -> TomlType -> TomlType
>= :: TomlType -> TomlType -> Bool
$c>= :: TomlType -> TomlType -> Bool
> :: TomlType -> TomlType -> Bool
$c> :: TomlType -> TomlType -> Bool
<= :: TomlType -> TomlType -> Bool
$c<= :: TomlType -> TomlType -> Bool
< :: TomlType -> TomlType -> Bool
$c< :: TomlType -> TomlType -> Bool
compare :: TomlType -> TomlType -> Ordering
$ccompare :: TomlType -> TomlType -> Ordering
$cp1Ord :: Eq TomlType
Ord, Int -> TomlType -> ShowS
[TomlType] -> ShowS
TomlType -> String
(Int -> TomlType -> ShowS)
-> (TomlType -> String) -> ([TomlType] -> ShowS) -> Show TomlType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TomlType] -> ShowS
$cshowList :: [TomlType] -> ShowS
show :: TomlType -> String
$cshow :: TomlType -> String
showsPrec :: Int -> TomlType -> ShowS
$cshowsPrec :: Int -> TomlType -> ShowS
Show, (forall x. TomlType -> Rep TomlType x)
-> (forall x. Rep TomlType x -> TomlType) -> Generic TomlType
forall x. Rep TomlType x -> TomlType
forall x. TomlType -> Rep TomlType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TomlType x -> TomlType
$cfrom :: forall x. TomlType -> Rep TomlType x
Generic)

getType :: Node -> TomlType
getType :: Node -> TomlType
getType = \case
  VTable{}    -> TomlType
TTable
  VTArray{}   -> TomlType
TTArray
  VString{}   -> TomlType
TString
  VInteger{}  -> TomlType
TInteger
  VFloat{}    -> TomlType
TFloat
  VBoolean{}  -> TomlType
TBoolean
  VDatetime{} -> TomlType
TDatetime
  VArray{}    -> TomlType
TArray

ppTomlType :: TomlType -> (Doc ann, Doc ann)
ppTomlType :: TomlType -> (Doc ann, Doc ann)
ppTomlType = \case
  TomlType
TTable    -> (Doc ann
"a",  Doc ann
"table")
  TomlType
TTArray   -> (Doc ann
"a",  Doc ann
"table array")
  TomlType
TString   -> (Doc ann
"a",  Doc ann
"string")
  TomlType
TInteger  -> (Doc ann
"an", Doc ann
"integer")
  TomlType
TFloat    -> (Doc ann
"a",  Doc ann
"float")
  TomlType
TBoolean  -> (Doc ann
"a",  Doc ann
"boolean")
  TomlType
TDatetime -> (Doc ann
"a",  Doc ann
"datetime")
  TomlType
TArray    -> (Doc ann
"an", Doc ann
"array")

data TomlPath
  = PathIndex !Int
  | PathKey !Text
  | PathOther !Text
  deriving (TomlPath -> TomlPath -> Bool
(TomlPath -> TomlPath -> Bool)
-> (TomlPath -> TomlPath -> Bool) -> Eq TomlPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlPath -> TomlPath -> Bool
$c/= :: TomlPath -> TomlPath -> Bool
== :: TomlPath -> TomlPath -> Bool
$c== :: TomlPath -> TomlPath -> Bool
Eq, Eq TomlPath
Eq TomlPath
-> (TomlPath -> TomlPath -> Ordering)
-> (TomlPath -> TomlPath -> Bool)
-> (TomlPath -> TomlPath -> Bool)
-> (TomlPath -> TomlPath -> Bool)
-> (TomlPath -> TomlPath -> Bool)
-> (TomlPath -> TomlPath -> TomlPath)
-> (TomlPath -> TomlPath -> TomlPath)
-> Ord TomlPath
TomlPath -> TomlPath -> Bool
TomlPath -> TomlPath -> Ordering
TomlPath -> TomlPath -> TomlPath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TomlPath -> TomlPath -> TomlPath
$cmin :: TomlPath -> TomlPath -> TomlPath
max :: TomlPath -> TomlPath -> TomlPath
$cmax :: TomlPath -> TomlPath -> TomlPath
>= :: TomlPath -> TomlPath -> Bool
$c>= :: TomlPath -> TomlPath -> Bool
> :: TomlPath -> TomlPath -> Bool
$c> :: TomlPath -> TomlPath -> Bool
<= :: TomlPath -> TomlPath -> Bool
$c<= :: TomlPath -> TomlPath -> Bool
< :: TomlPath -> TomlPath -> Bool
$c< :: TomlPath -> TomlPath -> Bool
compare :: TomlPath -> TomlPath -> Ordering
$ccompare :: TomlPath -> TomlPath -> Ordering
$cp1Ord :: Eq TomlPath
Ord, Int -> TomlPath -> ShowS
[TomlPath] -> ShowS
TomlPath -> String
(Int -> TomlPath -> ShowS)
-> (TomlPath -> String) -> ([TomlPath] -> ShowS) -> Show TomlPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TomlPath] -> ShowS
$cshowList :: [TomlPath] -> ShowS
show :: TomlPath -> String
$cshow :: TomlPath -> String
showsPrec :: Int -> TomlPath -> ShowS
$cshowsPrec :: Int -> TomlPath -> ShowS
Show, (forall x. TomlPath -> Rep TomlPath x)
-> (forall x. Rep TomlPath x -> TomlPath) -> Generic TomlPath
forall x. Rep TomlPath x -> TomlPath
forall x. TomlPath -> Rep TomlPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TomlPath x -> TomlPath
$cfrom :: forall x. TomlPath -> Rep TomlPath x
Generic)

instance Pretty TomlPath where
  pretty :: TomlPath -> Doc ann
pretty = \case
    PathIndex Int
n     -> Doc ann
"In array element" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
n
    PathKey Text
str     -> Doc ann
"In table key" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
str)
    PathOther Text
thing -> Doc ann
"While parsing" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
thing

data AtomicTomlError
  = UnexpectedType
      !TomlType -- ^ Expected
      Node      -- ^ Got
  | MissingKey !Text Table
  | IndexOutOfBounds !Int Node
  | OtherError (Doc Void)
  deriving (Int -> AtomicTomlError -> ShowS
[AtomicTomlError] -> ShowS
AtomicTomlError -> String
(Int -> AtomicTomlError -> ShowS)
-> (AtomicTomlError -> String)
-> ([AtomicTomlError] -> ShowS)
-> Show AtomicTomlError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtomicTomlError] -> ShowS
$cshowList :: [AtomicTomlError] -> ShowS
show :: AtomicTomlError -> String
$cshow :: AtomicTomlError -> String
showsPrec :: Int -> AtomicTomlError -> ShowS
$cshowsPrec :: Int -> AtomicTomlError -> ShowS
Show, (forall x. AtomicTomlError -> Rep AtomicTomlError x)
-> (forall x. Rep AtomicTomlError x -> AtomicTomlError)
-> Generic AtomicTomlError
forall x. Rep AtomicTomlError x -> AtomicTomlError
forall x. AtomicTomlError -> Rep AtomicTomlError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AtomicTomlError x -> AtomicTomlError
$cfrom :: forall x. AtomicTomlError -> Rep AtomicTomlError x
Generic)

-- | Prettyprint toml value.
ppToml :: Node -> Doc ann
ppToml :: Node -> Doc ann
ppToml = \case
  VTable    Table
x  -> (Text -> Doc ann) -> (Node -> Doc ann) -> Table -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> HashMap k v -> Doc ann
ppHashMapWith Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Node -> Doc ann
forall ann. Node -> Doc ann
ppToml Table
x
  VTArray   VTArray
xs -> (Table -> Doc ann) -> VTArray -> Doc ann
forall a ann. (a -> Doc ann) -> Vector a -> Doc ann
ppVectorWith ((Text -> Doc ann) -> (Node -> Doc ann) -> Table -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> HashMap k v -> Doc ann
ppHashMapWith Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Node -> Doc ann
forall ann. Node -> Doc ann
ppToml) VTArray
xs
  VString   Text
x  -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
x
  VInteger  Int64
x  -> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
x
  VFloat    Double
x  -> Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
x
  VBoolean  Bool
x  -> Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
x
  VDatetime UTCTime
x  -> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
x
  VArray    VArray
xs -> (Node -> Doc ann) -> VArray -> Doc ann
forall a ann. (a -> Doc ann) -> Vector a -> Doc ann
ppVectorWith Node -> Doc ann
forall ann. Node -> Doc ann
ppToml VArray
xs

instance Pretty AtomicTomlError where
  pretty :: AtomicTomlError -> Doc ann
pretty = \case
    UnexpectedType TomlType
expected Node
got ->
      Doc ann
"Expected to find" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
article Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
typ Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"but found" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
article' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
typ' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      Doc ann
"Node:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## Node -> Doc ann
forall ann. Node -> Doc ann
ppToml Node
got
      where
        (Doc ann
article,  Doc ann
typ)  = TomlType -> (Doc ann, Doc ann)
forall ann. TomlType -> (Doc ann, Doc ann)
ppTomlType TomlType
expected
        (Doc ann
article', Doc ann
typ') = TomlType -> (Doc ann, Doc ann)
forall ann. TomlType -> (Doc ann, Doc ann)
ppTomlType (TomlType -> (Doc ann, Doc ann)) -> TomlType -> (Doc ann, Doc ann)
forall a b. (a -> b) -> a -> b
$ Node -> TomlType
getType Node
got
    MissingKey Text
key Table
tab          -> Doc ann
"Missing key" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
key) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in table:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## (Text -> Doc ann) -> (Node -> Doc ann) -> Table -> Doc ann
forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> HashMap k v -> Doc ann
ppHashMapWith Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Node -> Doc ann
forall ann. Node -> Doc ann
ppToml Table
tab
    IndexOutOfBounds Int
ix Node
node    -> Doc ann
"Index" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
ix Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is out of bounds in array:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## Node -> Doc ann
forall ann. Node -> Doc ann
ppToml Node
node
    OtherError Doc Void
err              -> Doc ann
"Other error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## Doc Void -> Doc ann
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous Doc Void
err

data TomlError
  = ErrorEmpty
  | ErrorAtomic !AtomicTomlError
  -- | Invariant: children of ErrorAnd never share common prefix.
  | ErrorAnd TomlError TomlError
  -- | Invariant: children of ErrorOr never share common prefix.
  | ErrorOr TomlError TomlError
  | ErrorPrefix (NonEmpty TomlPath) TomlError
  deriving (Int -> TomlError -> ShowS
[TomlError] -> ShowS
TomlError -> String
(Int -> TomlError -> ShowS)
-> (TomlError -> String)
-> ([TomlError] -> ShowS)
-> Show TomlError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TomlError] -> ShowS
$cshowList :: [TomlError] -> ShowS
show :: TomlError -> String
$cshow :: TomlError -> String
showsPrec :: Int -> TomlError -> ShowS
$cshowsPrec :: Int -> TomlError -> ShowS
Show, (forall x. TomlError -> Rep TomlError x)
-> (forall x. Rep TomlError x -> TomlError) -> Generic TomlError
forall x. Rep TomlError x -> TomlError
forall x. TomlError -> Rep TomlError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TomlError x -> TomlError
$cfrom :: forall x. TomlError -> Rep TomlError x
Generic)

instance Pretty TomlError where
  pretty :: TomlError -> Doc ann
pretty = \case
    TomlError
ErrorEmpty       -> Doc ann
"Control.Applicative.empty"
    ErrorAtomic AtomicTomlError
err  -> AtomicTomlError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty AtomicTomlError
err
    ErrorAnd TomlError
x TomlError
y     -> Doc ann
"AND" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (TomlError -> Doc ann) -> [TomlError] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TomlError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([TomlError] -> [Doc ann]) -> [TomlError] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ DList TomlError -> [TomlError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (DList TomlError -> [TomlError]) -> DList TomlError -> [TomlError]
forall a b. (a -> b) -> a -> b
$ TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
x TomlError
y)
    ErrorOr  TomlError
x TomlError
y     -> Doc ann
"OR"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (TomlError -> Doc ann) -> [TomlError] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TomlError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([TomlError] -> [Doc ann]) -> [TomlError] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ DList TomlError -> [TomlError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (DList TomlError -> [TomlError]) -> DList TomlError -> [TomlError]
forall a b. (a -> b) -> a -> b
$ TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
x TomlError
y)
    ErrorPrefix NonEmpty TomlPath
ps TomlError
e -> (TomlPath -> Doc ann -> Doc ann)
-> Doc ann -> NonEmpty TomlPath -> Doc ann
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TomlPath
p Doc ann
acc -> TomlPath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TomlPath
p Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
## Doc ann
acc) (TomlError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TomlError
e) NonEmpty TomlPath
ps
    where
      collectConjuctions :: TomlError -> TomlError -> DList TomlError
      collectConjuctions :: TomlError -> TomlError -> DList TomlError
collectConjuctions (ErrorAnd TomlError
a TomlError
b) (ErrorAnd TomlError
c TomlError
d) = TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
a TomlError
b DList TomlError -> DList TomlError -> DList TomlError
forall a. Semigroup a => a -> a -> a
<> TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
c TomlError
d
      collectConjuctions (ErrorAnd TomlError
a TomlError
b) TomlError
c              = TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
a TomlError
b DList TomlError -> DList TomlError -> DList TomlError
forall a. Semigroup a => a -> a -> a
<> TomlError -> DList TomlError
forall a. a -> DList a
DL.singleton TomlError
c
      collectConjuctions TomlError
a              (ErrorAnd TomlError
c TomlError
d) = TomlError -> DList TomlError
forall a. a -> DList a
DL.singleton TomlError
a DList TomlError -> DList TomlError -> DList TomlError
forall a. Semigroup a => a -> a -> a
<> TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
c TomlError
d
      collectConjuctions TomlError
a              TomlError
c              = [TomlError] -> DList TomlError
forall a. [a] -> DList a
DL.fromList [TomlError
a, TomlError
c]

      collectDisjunctions :: TomlError -> TomlError -> DList TomlError
      collectDisjunctions :: TomlError -> TomlError -> DList TomlError
collectDisjunctions (ErrorOr TomlError
a TomlError
b) (ErrorOr TomlError
c TomlError
d) = TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
a TomlError
b DList TomlError -> DList TomlError -> DList TomlError
forall a. Semigroup a => a -> a -> a
<> TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
c TomlError
d
      collectDisjunctions (ErrorOr TomlError
a TomlError
b) TomlError
c             = TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
a TomlError
b DList TomlError -> DList TomlError -> DList TomlError
forall a. Semigroup a => a -> a -> a
<> TomlError -> DList TomlError
forall a. a -> DList a
DL.singleton TomlError
c
      collectDisjunctions TomlError
a             (ErrorOr TomlError
c TomlError
d) = TomlError -> DList TomlError
forall a. a -> DList a
DL.singleton TomlError
a DList TomlError -> DList TomlError -> DList TomlError
forall a. Semigroup a => a -> a -> a
<> TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
c TomlError
d
      collectDisjunctions TomlError
a             TomlError
c             = [TomlError] -> DList TomlError
forall a. [a] -> DList a
DL.fromList [TomlError
a, TomlError
c]

-- NB order of constructors is important
data IsCommitted = Uncommitted | Committed
  deriving (IsCommitted -> IsCommitted -> Bool
(IsCommitted -> IsCommitted -> Bool)
-> (IsCommitted -> IsCommitted -> Bool) -> Eq IsCommitted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsCommitted -> IsCommitted -> Bool
$c/= :: IsCommitted -> IsCommitted -> Bool
== :: IsCommitted -> IsCommitted -> Bool
$c== :: IsCommitted -> IsCommitted -> Bool
Eq, Eq IsCommitted
Eq IsCommitted
-> (IsCommitted -> IsCommitted -> Ordering)
-> (IsCommitted -> IsCommitted -> Bool)
-> (IsCommitted -> IsCommitted -> Bool)
-> (IsCommitted -> IsCommitted -> Bool)
-> (IsCommitted -> IsCommitted -> Bool)
-> (IsCommitted -> IsCommitted -> IsCommitted)
-> (IsCommitted -> IsCommitted -> IsCommitted)
-> Ord IsCommitted
IsCommitted -> IsCommitted -> Bool
IsCommitted -> IsCommitted -> Ordering
IsCommitted -> IsCommitted -> IsCommitted
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IsCommitted -> IsCommitted -> IsCommitted
$cmin :: IsCommitted -> IsCommitted -> IsCommitted
max :: IsCommitted -> IsCommitted -> IsCommitted
$cmax :: IsCommitted -> IsCommitted -> IsCommitted
>= :: IsCommitted -> IsCommitted -> Bool
$c>= :: IsCommitted -> IsCommitted -> Bool
> :: IsCommitted -> IsCommitted -> Bool
$c> :: IsCommitted -> IsCommitted -> Bool
<= :: IsCommitted -> IsCommitted -> Bool
$c<= :: IsCommitted -> IsCommitted -> Bool
< :: IsCommitted -> IsCommitted -> Bool
$c< :: IsCommitted -> IsCommitted -> Bool
compare :: IsCommitted -> IsCommitted -> Ordering
$ccompare :: IsCommitted -> IsCommitted -> Ordering
$cp1Ord :: Eq IsCommitted
Ord, Int -> IsCommitted -> ShowS
[IsCommitted] -> ShowS
IsCommitted -> String
(Int -> IsCommitted -> ShowS)
-> (IsCommitted -> String)
-> ([IsCommitted] -> ShowS)
-> Show IsCommitted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsCommitted] -> ShowS
$cshowList :: [IsCommitted] -> ShowS
show :: IsCommitted -> String
$cshow :: IsCommitted -> String
showsPrec :: Int -> IsCommitted -> ShowS
$cshowsPrec :: Int -> IsCommitted -> ShowS
Show, Int -> IsCommitted
IsCommitted -> Int
IsCommitted -> [IsCommitted]
IsCommitted -> IsCommitted
IsCommitted -> IsCommitted -> [IsCommitted]
IsCommitted -> IsCommitted -> IsCommitted -> [IsCommitted]
(IsCommitted -> IsCommitted)
-> (IsCommitted -> IsCommitted)
-> (Int -> IsCommitted)
-> (IsCommitted -> Int)
-> (IsCommitted -> [IsCommitted])
-> (IsCommitted -> IsCommitted -> [IsCommitted])
-> (IsCommitted -> IsCommitted -> [IsCommitted])
-> (IsCommitted -> IsCommitted -> IsCommitted -> [IsCommitted])
-> Enum IsCommitted
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IsCommitted -> IsCommitted -> IsCommitted -> [IsCommitted]
$cenumFromThenTo :: IsCommitted -> IsCommitted -> IsCommitted -> [IsCommitted]
enumFromTo :: IsCommitted -> IsCommitted -> [IsCommitted]
$cenumFromTo :: IsCommitted -> IsCommitted -> [IsCommitted]
enumFromThen :: IsCommitted -> IsCommitted -> [IsCommitted]
$cenumFromThen :: IsCommitted -> IsCommitted -> [IsCommitted]
enumFrom :: IsCommitted -> [IsCommitted]
$cenumFrom :: IsCommitted -> [IsCommitted]
fromEnum :: IsCommitted -> Int
$cfromEnum :: IsCommitted -> Int
toEnum :: Int -> IsCommitted
$ctoEnum :: Int -> IsCommitted
pred :: IsCommitted -> IsCommitted
$cpred :: IsCommitted -> IsCommitted
succ :: IsCommitted -> IsCommitted
$csucc :: IsCommitted -> IsCommitted
Enum, IsCommitted
IsCommitted -> IsCommitted -> Bounded IsCommitted
forall a. a -> a -> Bounded a
maxBound :: IsCommitted
$cmaxBound :: IsCommitted
minBound :: IsCommitted
$cminBound :: IsCommitted
Bounded)

instance Semigroup IsCommitted where
  {-# INLINE (<>) #-}
  <> :: IsCommitted -> IsCommitted -> IsCommitted
(<>) = IsCommitted -> IsCommitted -> IsCommitted
forall a. Ord a => a -> a -> a
max

newtype Validation a = Validation
  { Validation a -> Either (IsCommitted, TomlError) a
unValidation :: Either (IsCommitted, TomlError) a }
  deriving (a -> Validation b -> Validation a
(a -> b) -> Validation a -> Validation b
(forall a b. (a -> b) -> Validation a -> Validation b)
-> (forall a b. a -> Validation b -> Validation a)
-> Functor Validation
forall a b. a -> Validation b -> Validation a
forall a b. (a -> b) -> Validation a -> Validation b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Validation b -> Validation a
$c<$ :: forall a b. a -> Validation b -> Validation a
fmap :: (a -> b) -> Validation a -> Validation b
$cfmap :: forall a b. (a -> b) -> Validation a -> Validation b
Functor)

zipErrors
  :: (TomlError -> TomlError -> TomlError)
  -> TomlError
  -> TomlError
  -> TomlError
zipErrors :: (TomlError -> TomlError -> TomlError)
-> TomlError -> TomlError -> TomlError
zipErrors TomlError -> TomlError -> TomlError
f TomlError
x TomlError
y = case TomlError
-> TomlError -> Maybe (NonEmpty TomlPath, TomlError, TomlError)
commonPrefix TomlError
x TomlError
y of
  Maybe (NonEmpty TomlPath, TomlError, TomlError)
Nothing               -> TomlError -> TomlError -> TomlError
f TomlError
x TomlError
y
  Just (NonEmpty TomlPath
common, TomlError
x', TomlError
y') ->
    NonEmpty TomlPath -> TomlError -> TomlError
ErrorPrefix NonEmpty TomlPath
common (TomlError -> TomlError -> TomlError
f TomlError
x' TomlError
y')

commonPrefix
  :: TomlError
  -> TomlError
  -> Maybe (NonEmpty TomlPath, TomlError, TomlError)
commonPrefix :: TomlError
-> TomlError -> Maybe (NonEmpty TomlPath, TomlError, TomlError)
commonPrefix TomlError
x TomlError
y = case (TomlError
x, TomlError
y) of
  (ErrorPrefix NonEmpty TomlPath
px TomlError
x', ErrorPrefix NonEmpty TomlPath
py TomlError
y') ->
    (((NonEmpty TomlPath, [TomlPath], [TomlPath])
  -> (NonEmpty TomlPath, TomlError, TomlError))
 -> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
 -> Maybe (NonEmpty TomlPath, TomlError, TomlError))
-> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
-> ((NonEmpty TomlPath, [TomlPath], [TomlPath])
    -> (NonEmpty TomlPath, TomlError, TomlError))
-> Maybe (NonEmpty TomlPath, TomlError, TomlError)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NonEmpty TomlPath, [TomlPath], [TomlPath])
 -> (NonEmpty TomlPath, TomlError, TomlError))
-> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
-> Maybe (NonEmpty TomlPath, TomlError, TomlError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty TomlPath
-> NonEmpty TomlPath
-> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
go NonEmpty TomlPath
px NonEmpty TomlPath
py) (((NonEmpty TomlPath, [TomlPath], [TomlPath])
  -> (NonEmpty TomlPath, TomlError, TomlError))
 -> Maybe (NonEmpty TomlPath, TomlError, TomlError))
-> ((NonEmpty TomlPath, [TomlPath], [TomlPath])
    -> (NonEmpty TomlPath, TomlError, TomlError))
-> Maybe (NonEmpty TomlPath, TomlError, TomlError)
forall a b. (a -> b) -> a -> b
$ \(NonEmpty TomlPath
common, [TomlPath]
px', [TomlPath]
py') ->
      let prefix :: [TomlPath] -> TomlError -> TomlError
prefix []       TomlError
err = TomlError
err
          prefix (TomlPath
p : [TomlPath]
ps) TomlError
err = NonEmpty TomlPath -> TomlError -> TomlError
ErrorPrefix (TomlPath
p TomlPath -> [TomlPath] -> NonEmpty TomlPath
forall a. a -> [a] -> NonEmpty a
:| [TomlPath]
ps) TomlError
err
      in (NonEmpty TomlPath
common, [TomlPath] -> TomlError -> TomlError
prefix [TomlPath]
px' TomlError
x', [TomlPath] -> TomlError -> TomlError
prefix [TomlPath]
py' TomlError
y')
  (TomlError, TomlError)
_ -> Maybe (NonEmpty TomlPath, TomlError, TomlError)
forall a. Maybe a
Nothing
  where
    go :: NonEmpty TomlPath -> NonEmpty TomlPath -> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
    go :: NonEmpty TomlPath
-> NonEmpty TomlPath
-> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
go NonEmpty TomlPath
xs NonEmpty TomlPath
ys =
      case [TomlPath]
-> [TomlPath] -> [TomlPath] -> ([TomlPath], [TomlPath], [TomlPath])
forall a. Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
go' [] (NonEmpty TomlPath -> [TomlPath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TomlPath
xs) (NonEmpty TomlPath -> [TomlPath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TomlPath
ys) of
        (TomlPath
c : [TomlPath]
cs, [TomlPath]
xs', [TomlPath]
ys') -> (NonEmpty TomlPath, [TomlPath], [TomlPath])
-> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
forall a. a -> Maybe a
Just (TomlPath
c TomlPath -> [TomlPath] -> NonEmpty TomlPath
forall a. a -> [a] -> NonEmpty a
:| [TomlPath]
cs, [TomlPath]
xs', [TomlPath]
ys')
        ([TomlPath], [TomlPath], [TomlPath])
_ -> Maybe (NonEmpty TomlPath, [TomlPath], [TomlPath])
forall a. Maybe a
Nothing
    go' :: Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
    go' :: [a] -> [a] -> [a] -> ([a], [a], [a])
go' [a]
common (a
a : [a]
as) (a
b : [a]
bs)
      | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [a] -> [a] -> [a] -> ([a], [a], [a])
forall a. Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
go' (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
common) [a]
as [a]
bs
    go' [a]
common [a]
as [a]
bs = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
common, [a]
as, [a]
bs)

instance Applicative Validation where
  {-# INLINE pure #-}
  pure :: a -> Validation a
pure = Either (IsCommitted, TomlError) a -> Validation a
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) a -> Validation a)
-> (a -> Either (IsCommitted, TomlError) a) -> a -> Validation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (IsCommitted, TomlError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# NOINLINE (<*>) #-}
  <*> :: Validation (a -> b) -> Validation a -> Validation b
(<*>) vf' :: Validation (a -> b)
vf'@(Validation Either (IsCommitted, TomlError) (a -> b)
vf) vx' :: Validation a
vx'@(Validation Either (IsCommitted, TomlError) a
vx) =
    case (Either (IsCommitted, TomlError) (a -> b)
vf, Either (IsCommitted, TomlError) a
vx) of
      (Left (IsCommitted
cf, TomlError
ef), Left (IsCommitted
cx, TomlError
ex)) -> Either (IsCommitted, TomlError) b -> Validation b
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) b -> Validation b)
-> Either (IsCommitted, TomlError) b -> Validation b
forall a b. (a -> b) -> a -> b
$ (IsCommitted, TomlError) -> Either (IsCommitted, TomlError) b
forall a b. a -> Either a b
Left (IsCommitted
cf IsCommitted -> IsCommitted -> IsCommitted
forall a. Semigroup a => a -> a -> a
<> IsCommitted
cx, (TomlError -> TomlError -> TomlError)
-> TomlError -> TomlError -> TomlError
zipErrors TomlError -> TomlError -> TomlError
ErrorAnd TomlError
ef TomlError
ex)
      (Left (IsCommitted, TomlError)
_,        Either (IsCommitted, TomlError) a
_)             -> Validation (a -> b) -> Validation b
forall a b. a -> b
unsafeCoerce Validation (a -> b)
vf'
      (Either (IsCommitted, TomlError) (a -> b)
_,             Left (IsCommitted, TomlError)
_)        -> Validation a -> Validation b
forall a b. a -> b
unsafeCoerce Validation a
vx'
      (Right a -> b
f,       Right a
x)       -> Either (IsCommitted, TomlError) b -> Validation b
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) b -> Validation b)
-> Either (IsCommitted, TomlError) b -> Validation b
forall a b. (a -> b) -> a -> b
$ b -> Either (IsCommitted, TomlError) b
forall a b. b -> Either a b
Right (b -> Either (IsCommitted, TomlError) b)
-> b -> Either (IsCommitted, TomlError) b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Alternative Validation where
  {-# INLINE empty #-}
  empty :: Validation a
empty = Either (IsCommitted, TomlError) a -> Validation a
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) a -> Validation a)
-> Either (IsCommitted, TomlError) a -> Validation a
forall a b. (a -> b) -> a -> b
$ (IsCommitted, TomlError) -> Either (IsCommitted, TomlError) a
forall a b. a -> Either a b
Left (IsCommitted
Uncommitted, TomlError
ErrorEmpty)
  {-# NOINLINE (<|>) #-}
  <|> :: Validation a -> Validation a -> Validation a
(<|>) x' :: Validation a
x'@(Validation Either (IsCommitted, TomlError) a
x) y' :: Validation a
y'@(Validation Either (IsCommitted, TomlError) a
y) =
    case (Either (IsCommitted, TomlError) a
x, Either (IsCommitted, TomlError) a
y) of
      (Right a
_,       Either (IsCommitted, TomlError) a
_)             -> Validation a
x'
      (Either (IsCommitted, TomlError) a
_,             Right a
_)       -> Validation a
y'
      (Left (IsCommitted
cf, TomlError
ef), Left (IsCommitted
cx, TomlError
ex)) ->
        case (IsCommitted
cf, IsCommitted
cx) of
          (IsCommitted
Committed,   IsCommitted
Uncommitted) -> Validation a
x'
          (IsCommitted
Uncommitted, IsCommitted
Committed)   -> Validation a
y'
          (IsCommitted, IsCommitted)
_                          -> Either (IsCommitted, TomlError) a -> Validation a
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) a -> Validation a)
-> Either (IsCommitted, TomlError) a -> Validation a
forall a b. (a -> b) -> a -> b
$ (IsCommitted, TomlError) -> Either (IsCommitted, TomlError) a
forall a b. a -> Either a b
Left (IsCommitted
cf IsCommitted -> IsCommitted -> IsCommitted
forall a. Semigroup a => a -> a -> a
<> IsCommitted
cx, (TomlError -> TomlError -> TomlError)
-> TomlError -> TomlError -> TomlError
zipErrors TomlError -> TomlError -> TomlError
ErrorOr TomlError
ef TomlError
ex)

instance Monad Validation where
  {-# INLINE (>>=) #-}
  {-# INLINE (>>)  #-}
  >>= :: Validation a -> (a -> Validation b) -> Validation b
(>>=) x' :: Validation a
x'@(Validation Either (IsCommitted, TomlError) a
x) a -> Validation b
f =
    case Either (IsCommitted, TomlError) a
x of
      Left  (IsCommitted, TomlError)
_ -> Validation a -> Validation b
forall a b. a -> b
unsafeCoerce Validation a
x'
      Right a
y -> Validation b -> Validation b
forall a. Validation a -> Validation a
commit (Validation b -> Validation b) -> Validation b -> Validation b
forall a b. (a -> b) -> a -> b
$ a -> Validation b
f a
y
    where
      commit :: Validation a -> Validation a
commit (Validation (Left (IsCommitted
_, TomlError
err))) = Either (IsCommitted, TomlError) a -> Validation a
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) a -> Validation a)
-> Either (IsCommitted, TomlError) a -> Validation a
forall a b. (a -> b) -> a -> b
$ (IsCommitted, TomlError) -> Either (IsCommitted, TomlError) a
forall a b. a -> Either a b
Left (IsCommitted
Committed, TomlError
err)
      commit z :: Validation a
z@(Validation (Right a
_))     = Validation a
z
  >> :: Validation a -> Validation b -> Validation b
(>>) = Validation a -> Validation b -> Validation b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

instance MonadPlus Validation

newtype ParseEnv = ParseEnv { ParseEnv -> [TomlPath]
unParseEnv :: [TomlPath] }
  deriving (ParseEnv -> ParseEnv -> Bool
(ParseEnv -> ParseEnv -> Bool)
-> (ParseEnv -> ParseEnv -> Bool) -> Eq ParseEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseEnv -> ParseEnv -> Bool
$c/= :: ParseEnv -> ParseEnv -> Bool
== :: ParseEnv -> ParseEnv -> Bool
$c== :: ParseEnv -> ParseEnv -> Bool
Eq, Eq ParseEnv
Eq ParseEnv
-> (ParseEnv -> ParseEnv -> Ordering)
-> (ParseEnv -> ParseEnv -> Bool)
-> (ParseEnv -> ParseEnv -> Bool)
-> (ParseEnv -> ParseEnv -> Bool)
-> (ParseEnv -> ParseEnv -> Bool)
-> (ParseEnv -> ParseEnv -> ParseEnv)
-> (ParseEnv -> ParseEnv -> ParseEnv)
-> Ord ParseEnv
ParseEnv -> ParseEnv -> Bool
ParseEnv -> ParseEnv -> Ordering
ParseEnv -> ParseEnv -> ParseEnv
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParseEnv -> ParseEnv -> ParseEnv
$cmin :: ParseEnv -> ParseEnv -> ParseEnv
max :: ParseEnv -> ParseEnv -> ParseEnv
$cmax :: ParseEnv -> ParseEnv -> ParseEnv
>= :: ParseEnv -> ParseEnv -> Bool
$c>= :: ParseEnv -> ParseEnv -> Bool
> :: ParseEnv -> ParseEnv -> Bool
$c> :: ParseEnv -> ParseEnv -> Bool
<= :: ParseEnv -> ParseEnv -> Bool
$c<= :: ParseEnv -> ParseEnv -> Bool
< :: ParseEnv -> ParseEnv -> Bool
$c< :: ParseEnv -> ParseEnv -> Bool
compare :: ParseEnv -> ParseEnv -> Ordering
$ccompare :: ParseEnv -> ParseEnv -> Ordering
$cp1Ord :: Eq ParseEnv
Ord, Int -> ParseEnv -> ShowS
[ParseEnv] -> ShowS
ParseEnv -> String
(Int -> ParseEnv -> ShowS)
-> (ParseEnv -> String) -> ([ParseEnv] -> ShowS) -> Show ParseEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseEnv] -> ShowS
$cshowList :: [ParseEnv] -> ShowS
show :: ParseEnv -> String
$cshow :: ParseEnv -> String
showsPrec :: Int -> ParseEnv -> ShowS
$cshowsPrec :: Int -> ParseEnv -> ShowS
Show, (forall x. ParseEnv -> Rep ParseEnv x)
-> (forall x. Rep ParseEnv x -> ParseEnv) -> Generic ParseEnv
forall x. Rep ParseEnv x -> ParseEnv
forall x. ParseEnv -> Rep ParseEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseEnv x -> ParseEnv
$cfrom :: forall x. ParseEnv -> Rep ParseEnv x
Generic, [ParseEnv] -> Doc ann
ParseEnv -> Doc ann
(forall ann. ParseEnv -> Doc ann)
-> (forall ann. [ParseEnv] -> Doc ann) -> Pretty ParseEnv
forall ann. [ParseEnv] -> Doc ann
forall ann. ParseEnv -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [ParseEnv] -> Doc ann
$cprettyList :: forall ann. [ParseEnv] -> Doc ann
pretty :: ParseEnv -> Doc ann
$cpretty :: forall ann. ParseEnv -> Doc ann
Pretty)

newtype Parser a = Parser
  { Parser a -> Validation a
unParser :: Validation a }
  deriving (a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor, Functor Parser
a -> Parser a
Functor Parser
-> (forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
Parser a -> Parser b -> Parser b
Parser a -> Parser b -> Parser a
Parser (a -> b) -> Parser a -> Parser b
(a -> b -> c) -> Parser a -> Parser b -> Parser c
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser 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
<* :: Parser a -> Parser b -> Parser a
$c<* :: forall a b. Parser a -> Parser b -> Parser a
*> :: Parser a -> Parser b -> Parser b
$c*> :: forall a b. Parser a -> Parser b -> Parser b
liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
<*> :: Parser (a -> b) -> Parser a -> Parser b
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
pure :: a -> Parser a
$cpure :: forall a. a -> Parser a
$cp1Applicative :: Functor Parser
Applicative, Applicative Parser
Parser a
Applicative Parser
-> (forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a)
-> (forall a. Parser a -> Parser [a])
-> (forall a. Parser a -> Parser [a])
-> Alternative Parser
Parser a -> Parser a -> Parser a
Parser a -> Parser [a]
Parser a -> Parser [a]
forall a. Parser a
forall a. Parser a -> Parser [a]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Parser a -> Parser [a]
$cmany :: forall a. Parser a -> Parser [a]
some :: Parser a -> Parser [a]
$csome :: forall a. Parser a -> Parser [a]
<|> :: Parser a -> Parser a -> Parser a
$c<|> :: forall a. Parser a -> Parser a -> Parser a
empty :: Parser a
$cempty :: forall a. Parser a
$cp1Alternative :: Applicative Parser
Alternative, Monad Parser
Alternative Parser
Parser a
Alternative Parser
-> Monad Parser
-> (forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a)
-> MonadPlus Parser
Parser a -> Parser a -> Parser a
forall a. Parser a
forall a. Parser a -> Parser a -> Parser a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Parser a -> Parser a -> Parser a
$cmplus :: forall a. Parser a -> Parser a -> Parser a
mzero :: Parser a
$cmzero :: forall a. Parser a
$cp2MonadPlus :: Monad Parser
$cp1MonadPlus :: Alternative Parser
MonadPlus)

instance Monad Parser where
  {-# INLINE (>>=) #-}
  {-# INLINE (>>)  #-}
  >>= :: Parser a -> (a -> Parser b) -> Parser b
(>>=) (Parser Validation a
x) a -> Parser b
f = Validation b -> Parser b
forall a. Validation a -> Parser a
Parser (Validation b -> Parser b) -> Validation b -> Parser b
forall a b. (a -> b) -> a -> b
$ do
    a
x' <- Validation a
x
    Parser b -> Validation b
forall a. Parser a -> Validation a
unParser (Parser b -> Validation b) -> Parser b -> Validation b
forall a b. (a -> b) -> a -> b
$ a -> Parser b
f a
x'
  >> :: Parser a -> Parser b -> Parser b
(>>) = Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

infixl 9 <?>

-- | Add textual annotation to the provided located thing. The annotation will
-- be shows as part of error message if the location ultimately gets passed to
-- 'throwParseError'.
(<?>) :: L a -> Text -> L a
<?> :: L a -> Text -> L a
(<?>) (L ParseEnv
env a
x) Text
y = ParseEnv -> a -> L a
forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Text -> TomlPath
PathOther Text
y) ParseEnv
env) a
x

instance TomlParse Parser where
  throwParseError :: L b -> AtomicTomlError -> Parser a
throwParseError L b
loc AtomicTomlError
err = Validation a -> Parser a
forall a. Validation a -> Parser a
Parser (Validation a -> Parser a) -> Validation a -> Parser a
forall a b. (a -> b) -> a -> b
$ Either (IsCommitted, TomlError) a -> Validation a
forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation (Either (IsCommitted, TomlError) a -> Validation a)
-> Either (IsCommitted, TomlError) a -> Validation a
forall a b. (a -> b) -> a -> b
$ (IsCommitted, TomlError) -> Either (IsCommitted, TomlError) a
forall a b. a -> Either a b
Left (IsCommitted
Uncommitted, L b -> AtomicTomlError -> TomlError
forall a. L a -> AtomicTomlError -> TomlError
mkTomlError' L b
loc AtomicTomlError
err)

runParser :: a -> (L a -> Parser b) -> Either (Doc Void) b
runParser :: a -> (L a -> Parser b) -> Either (Doc Void) b
runParser a
x L a -> Parser b
f
  = ((IsCommitted, TomlError) -> Doc Void)
-> Either (IsCommitted, TomlError) b -> Either (Doc Void) b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Doc Void
"Error while parsing:" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
##) (Doc Void -> Doc Void)
-> ((IsCommitted, TomlError) -> Doc Void)
-> (IsCommitted, TomlError)
-> Doc Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlError -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (TomlError -> Doc Void)
-> ((IsCommitted, TomlError) -> TomlError)
-> (IsCommitted, TomlError)
-> Doc Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsCommitted, TomlError) -> TomlError
forall a b. (a, b) -> b
snd)
  (Either (IsCommitted, TomlError) b -> Either (Doc Void) b)
-> Either (IsCommitted, TomlError) b -> Either (Doc Void) b
forall a b. (a -> b) -> a -> b
$ Validation b -> Either (IsCommitted, TomlError) b
forall a. Validation a -> Either (IsCommitted, TomlError) a
unValidation
  (Validation b -> Either (IsCommitted, TomlError) b)
-> Validation b -> Either (IsCommitted, TomlError) b
forall a b. (a -> b) -> a -> b
$ Parser b -> Validation b
forall a. Parser a -> Validation a
unParser
  (Parser b -> Validation b) -> Parser b -> Validation b
forall a b. (a -> b) -> a -> b
$ L a -> Parser b
f
  (L a -> Parser b) -> L a -> Parser b
forall a b. (a -> b) -> a -> b
$ ParseEnv -> a -> L a
forall a. ParseEnv -> a -> L a
L ([TomlPath] -> ParseEnv
ParseEnv []) a
x

mkTomlError :: L a -> Doc Void -> TomlError
mkTomlError :: L a -> Doc Void -> TomlError
mkTomlError L a
loc = L a -> AtomicTomlError -> TomlError
forall a. L a -> AtomicTomlError -> TomlError
mkTomlError' L a
loc (AtomicTomlError -> TomlError)
-> (Doc Void -> AtomicTomlError) -> Doc Void -> TomlError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Void -> AtomicTomlError
OtherError

mkTomlError' :: L a -> AtomicTomlError -> TomlError
mkTomlError' :: L a -> AtomicTomlError -> TomlError
mkTomlError' (L ParseEnv
env a
_) AtomicTomlError
err = case [TomlPath] -> [TomlPath]
forall a. [a] -> [a]
reverse ([TomlPath] -> [TomlPath]) -> [TomlPath] -> [TomlPath]
forall a b. (a -> b) -> a -> b
$ ParseEnv -> [TomlPath]
unParseEnv ParseEnv
env of
  []     -> AtomicTomlError -> TomlError
ErrorAtomic AtomicTomlError
err
  TomlPath
p : [TomlPath]
ps -> NonEmpty TomlPath -> TomlError -> TomlError
ErrorPrefix (TomlPath
p TomlPath -> [TomlPath] -> NonEmpty TomlPath
forall a. a -> [a] -> NonEmpty a
:| [TomlPath]
ps) (TomlError -> TomlError) -> TomlError -> TomlError
forall a b. (a -> b) -> a -> b
$ AtomicTomlError -> TomlError
ErrorAtomic AtomicTomlError
err

-- | Adds to 'a' its provenance in the toml file.
data L a = L ParseEnv a
  deriving (L a -> L a -> Bool
(L a -> L a -> Bool) -> (L a -> L a -> Bool) -> Eq (L a)
forall a. Eq a => L a -> L a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: L a -> L a -> Bool
$c/= :: forall a. Eq a => L a -> L a -> Bool
== :: L a -> L a -> Bool
$c== :: forall a. Eq a => L a -> L a -> Bool
Eq, Eq (L a)
Eq (L a)
-> (L a -> L a -> Ordering)
-> (L a -> L a -> Bool)
-> (L a -> L a -> Bool)
-> (L a -> L a -> Bool)
-> (L a -> L a -> Bool)
-> (L a -> L a -> L a)
-> (L a -> L a -> L a)
-> Ord (L a)
L a -> L a -> Bool
L a -> L a -> Ordering
L a -> L a -> L a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (L a)
forall a. Ord a => L a -> L a -> Bool
forall a. Ord a => L a -> L a -> Ordering
forall a. Ord a => L a -> L a -> L a
min :: L a -> L a -> L a
$cmin :: forall a. Ord a => L a -> L a -> L a
max :: L a -> L a -> L a
$cmax :: forall a. Ord a => L a -> L a -> L a
>= :: L a -> L a -> Bool
$c>= :: forall a. Ord a => L a -> L a -> Bool
> :: L a -> L a -> Bool
$c> :: forall a. Ord a => L a -> L a -> Bool
<= :: L a -> L a -> Bool
$c<= :: forall a. Ord a => L a -> L a -> Bool
< :: L a -> L a -> Bool
$c< :: forall a. Ord a => L a -> L a -> Bool
compare :: L a -> L a -> Ordering
$ccompare :: forall a. Ord a => L a -> L a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (L a)
Ord, Int -> L a -> ShowS
[L a] -> ShowS
L a -> String
(Int -> L a -> ShowS)
-> (L a -> String) -> ([L a] -> ShowS) -> Show (L a)
forall a. Show a => Int -> L a -> ShowS
forall a. Show a => [L a] -> ShowS
forall a. Show a => L a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L a] -> ShowS
$cshowList :: forall a. Show a => [L a] -> ShowS
show :: L a -> String
$cshow :: forall a. Show a => L a -> String
showsPrec :: Int -> L a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> L a -> ShowS
Show, a -> L b -> L a
(a -> b) -> L a -> L b
(forall a b. (a -> b) -> L a -> L b)
-> (forall a b. a -> L b -> L a) -> Functor L
forall a b. a -> L b -> L a
forall a b. (a -> b) -> L a -> L b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> L b -> L a
$c<$ :: forall a b. a -> L b -> L a
fmap :: (a -> b) -> L a -> L b
$cfmap :: forall a b. (a -> b) -> L a -> L b
Functor, L a -> Bool
(a -> m) -> L a -> m
(a -> b -> b) -> b -> L a -> b
(forall m. Monoid m => L m -> m)
-> (forall m a. Monoid m => (a -> m) -> L a -> m)
-> (forall m a. Monoid m => (a -> m) -> L a -> m)
-> (forall a b. (a -> b -> b) -> b -> L a -> b)
-> (forall a b. (a -> b -> b) -> b -> L a -> b)
-> (forall b a. (b -> a -> b) -> b -> L a -> b)
-> (forall b a. (b -> a -> b) -> b -> L a -> b)
-> (forall a. (a -> a -> a) -> L a -> a)
-> (forall a. (a -> a -> a) -> L a -> a)
-> (forall a. L a -> [a])
-> (forall a. L a -> Bool)
-> (forall a. L a -> Int)
-> (forall a. Eq a => a -> L a -> Bool)
-> (forall a. Ord a => L a -> a)
-> (forall a. Ord a => L a -> a)
-> (forall a. Num a => L a -> a)
-> (forall a. Num a => L a -> a)
-> Foldable L
forall a. Eq a => a -> L a -> Bool
forall a. Num a => L a -> a
forall a. Ord a => L a -> a
forall m. Monoid m => L m -> m
forall a. L a -> Bool
forall a. L a -> Int
forall a. L a -> [a]
forall a. (a -> a -> a) -> L a -> a
forall m a. Monoid m => (a -> m) -> L a -> m
forall b a. (b -> a -> b) -> b -> L a -> b
forall a b. (a -> b -> b) -> b -> L a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: L a -> a
$cproduct :: forall a. Num a => L a -> a
sum :: L a -> a
$csum :: forall a. Num a => L a -> a
minimum :: L a -> a
$cminimum :: forall a. Ord a => L a -> a
maximum :: L a -> a
$cmaximum :: forall a. Ord a => L a -> a
elem :: a -> L a -> Bool
$celem :: forall a. Eq a => a -> L a -> Bool
length :: L a -> Int
$clength :: forall a. L a -> Int
null :: L a -> Bool
$cnull :: forall a. L a -> Bool
toList :: L a -> [a]
$ctoList :: forall a. L a -> [a]
foldl1 :: (a -> a -> a) -> L a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> L a -> a
foldr1 :: (a -> a -> a) -> L a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> L a -> a
foldl' :: (b -> a -> b) -> b -> L a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> L a -> b
foldl :: (b -> a -> b) -> b -> L a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> L a -> b
foldr' :: (a -> b -> b) -> b -> L a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> L a -> b
foldr :: (a -> b -> b) -> b -> L a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> L a -> b
foldMap' :: (a -> m) -> L a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> L a -> m
foldMap :: (a -> m) -> L a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> L a -> m
fold :: L m -> m
$cfold :: forall m. Monoid m => L m -> m
Foldable, Functor L
Foldable L
Functor L
-> Foldable L
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> L a -> f (L b))
-> (forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> L a -> m (L b))
-> (forall (m :: * -> *) a. Monad m => L (m a) -> m (L a))
-> Traversable L
(a -> f b) -> L a -> f (L b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
sequence :: L (m a) -> m (L a)
$csequence :: forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
mapM :: (a -> m b) -> L a -> m (L b)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
sequenceA :: L (f a) -> f (L a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
traverse :: (a -> f b) -> L a -> f (L b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
$cp2Traversable :: Foldable L
$cp1Traversable :: Functor L
Traversable, (forall x. L a -> Rep (L a) x)
-> (forall x. Rep (L a) x -> L a) -> Generic (L a)
forall x. Rep (L a) x -> L a
forall x. L a -> Rep (L a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (L a) x -> L a
forall a x. L a -> Rep (L a) x
$cto :: forall a x. Rep (L a) x -> L a
$cfrom :: forall a x. L a -> Rep (L a) x
Generic)

instance Pretty a => Pretty (L a) where pretty :: L a -> Doc ann
pretty = L a -> Doc ann
forall a ann. (Generic a, GPretty (Rep a)) => a -> Doc ann
ppGeneric

instance Comonad L where
  {-# INLINE extract   #-}
  {-# INLINE duplicate #-}
  extract :: L a -> a
extract (L ParseEnv
_ a
x) = a
x
  duplicate :: L a -> L (L a)
duplicate orig :: L a
orig@(L ParseEnv
env a
_) = ParseEnv -> L a -> L (L a)
forall a. ParseEnv -> a -> L a
L ParseEnv
env L a
orig

{-# INLINE inside #-}
inside :: TomlPath -> ParseEnv -> ParseEnv
inside :: TomlPath -> ParseEnv -> ParseEnv
inside TomlPath
x (ParseEnv [TomlPath]
xs) = [TomlPath] -> ParseEnv
ParseEnv (TomlPath
x TomlPath -> [TomlPath] -> [TomlPath]
forall a. a -> [a] -> [a]
: [TomlPath]
xs)

class (Applicative m, Alternative m) => TomlParse m where
  throwParseError :: L b -> AtomicTomlError -> m a

class FromToml a b where
  fromToml :: L a -> Parser b

instance FromToml a (L a) where
  {-# INLINE fromToml #-}
  fromToml :: L a -> Parser (L a)
fromToml = L a -> Parser (L a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromToml a a where
  {-# INLINE fromToml #-}
  fromToml :: L a -> Parser a
fromToml = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> (L a -> a) -> L a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract

instance FromToml Node String where
  {-# INLINE fromToml #-}
  fromToml :: L Node -> Parser String
fromToml = (Text -> String) -> Parser Text -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack (Parser Text -> Parser String)
-> (L Node -> Parser Text) -> L Node -> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L Node -> Parser Text
forall (m :: * -> *). TomlParse m => L Node -> m Text
pStr

instance FromToml Node Text where
  {-# INLINE fromToml #-}
  fromToml :: L Node -> Parser Text
fromToml = L Node -> Parser Text
forall (m :: * -> *). TomlParse m => L Node -> m Text
pStr

instance FromToml Node Bool where
  {-# INLINE fromToml #-}
  fromToml :: L Node -> Parser Bool
fromToml = L Node -> Parser Bool
forall (m :: * -> *). TomlParse m => L Node -> m Bool
pBool

instance FromToml Node Int where
  {-# INLINE fromToml #-}
  fromToml :: L Node -> Parser Int
fromToml = L Node -> Parser Int
forall (m :: * -> *). TomlParse m => L Node -> m Int
pInt

instance FromToml Node Double where
  {-# INLINE fromToml #-}
  fromToml :: L Node -> Parser Double
fromToml = L Node -> Parser Double
forall (m :: * -> *). TomlParse m => L Node -> m Double
pDouble

instance FromToml Node UTCTime where
  {-# INLINE fromToml #-}
  fromToml :: L Node -> Parser UTCTime
fromToml = L Node -> Parser UTCTime
forall (m :: * -> *). TomlParse m => L Node -> m UTCTime
pDatetime

instance (Ord k, FromToml Text k, FromToml Node v) => FromToml Node (Map k v) where
  fromToml :: L Node -> Parser (Map k v)
fromToml = L Node -> Parser (L Table)
forall (m :: * -> *). TomlParse m => L Node -> m (L Table)
pTable (L Node -> Parser (L Table))
-> (L Table -> Parser (Map k v)) -> L Node -> Parser (Map k v)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> L Table -> Parser (Map k v)
forall a b. FromToml a b => L a -> Parser b
fromToml

instance (Ord k, FromToml Text k, FromToml Node v) => FromToml Table (Map k v) where
  fromToml :: L Table -> Parser (Map k v)
fromToml (L ParseEnv
env Table
y) = do
    [(k, v)]
ys <- [(Text, Node)]
-> ((Text, Node) -> Parser (k, v)) -> Parser [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Table -> [(Text, Node)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Table
y) (((Text, Node) -> Parser (k, v)) -> Parser [(k, v)])
-> ((Text, Node) -> Parser (k, v)) -> Parser [(k, v)]
forall a b. (a -> b) -> a -> b
$ \(Text
k, Node
v) ->
      (,)
        (k -> v -> (k, v)) -> Parser k -> Parser (v -> (k, v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> L Text -> Parser k
forall a b. FromToml a b => L a -> Parser b
fromToml (ParseEnv -> Text -> L Text
forall a. ParseEnv -> a -> L a
L ParseEnv
env Text
k)
        Parser (v -> (k, v)) -> Parser v -> Parser (k, v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> L Node -> Parser v
forall a b. FromToml a b => L a -> Parser b
fromToml (ParseEnv -> Node -> L Node
forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Text -> TomlPath
PathKey Text
k) ParseEnv
env) Node
v)
    Map k v -> Parser (Map k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k v -> Parser (Map k v)) -> Map k v -> Parser (Map k v)
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, v)]
ys

instance FromToml Node a => FromToml Node (Vector a) where
  fromToml :: L Node -> Parser (Vector a)
fromToml = L Node -> Parser (Vector (L Node))
forall (m :: * -> *). TomlParse m => L Node -> m (Vector (L Node))
pArray (L Node -> Parser (Vector (L Node)))
-> (Vector (L Node) -> Parser (Vector a))
-> L Node
-> Parser (Vector a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (L Node -> Parser a) -> Vector (L Node) -> Parser (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse L Node -> Parser a
forall a b. FromToml a b => L a -> Parser b
fromToml

instance FromToml Node a => FromToml Node (NonEmpty a) where
  fromToml :: L Node -> Parser (NonEmpty a)
fromToml L Node
x = do
    Vector (L Node)
ys <- L Node -> Parser (Vector (L Node))
forall (m :: * -> *). TomlParse m => L Node -> m (Vector (L Node))
pArray L Node
x
    case Vector (L Node) -> [L Node]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector (L Node)
ys of
      []     -> L Node -> AtomicTomlError -> Parser (NonEmpty a)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
x (AtomicTomlError -> Parser (NonEmpty a))
-> AtomicTomlError -> Parser (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ Doc Void -> AtomicTomlError
OtherError Doc Void
"Expected a non-empty list"
      L Node
z : [L Node]
zs -> a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(:|) (a -> [a] -> NonEmpty a) -> Parser a -> Parser ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> L Node -> Parser a
forall a b. FromToml a b => L a -> Parser b
fromToml L Node
z Parser ([a] -> NonEmpty a) -> Parser [a] -> Parser (NonEmpty a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (L Node -> Parser a) -> [L Node] -> Parser [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse L Node -> Parser a
forall a b. FromToml a b => L a -> Parser b
fromToml [L Node]
zs

infixl 5 .:, .:?, .!=

class Index a where
  (.:)  :: FromToml Node b => a -> Text -> Parser b
  (.:?) :: FromToml Node b => a -> Text -> Parser (Maybe b)

instance Index (L Table) where
  {-# INLINE (.:)  #-}
  {-# INLINE (.:?) #-}
  .: :: L Table -> Text -> Parser b
(.:)  L Table
x Text
key = Text -> L Table -> Parser (L Node)
forall (m :: * -> *). TomlParse m => Text -> L Table -> m (L Node)
pKey Text
key L Table
x Parser (L Node) -> (L Node -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= L Node -> Parser b
forall a b. FromToml a b => L a -> Parser b
fromToml
  .:? :: L Table -> Text -> Parser (Maybe b)
(.:?) L Table
x Text
key = (L Node -> Parser b) -> Maybe (L Node) -> Parser (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse L Node -> Parser b
forall a b. FromToml a b => L a -> Parser b
fromToml (Maybe (L Node) -> Parser (Maybe b))
-> Maybe (L Node) -> Parser (Maybe b)
forall a b. (a -> b) -> a -> b
$ L (Maybe Node) -> Maybe (L Node)
forall a. L (Maybe a) -> Maybe (L a)
liftMaybe (L (Maybe Node) -> Maybe (L Node))
-> L (Maybe Node) -> Maybe (L Node)
forall a b. (a -> b) -> a -> b
$ Text -> L Table -> L (Maybe Node)
pKeyMaybe Text
key L Table
x

instance Index (L Node) where
  {-# INLINE (.:)  #-}
  {-# INLINE (.:?) #-}
  .: :: L Node -> Text -> Parser b
(.:)  L Node
x Text
key = L Node -> Parser (L Table)
forall (m :: * -> *). TomlParse m => L Node -> m (L Table)
pTable L Node
x Parser (L Table) -> (L Table -> Parser (L Node)) -> Parser (L Node)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> L Table -> Parser (L Node)
forall (m :: * -> *). TomlParse m => Text -> L Table -> m (L Node)
pKey Text
key Parser (L Node) -> (L Node -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= L Node -> Parser b
forall a b. FromToml a b => L a -> Parser b
fromToml
  .:? :: L Node -> Text -> Parser (Maybe b)
(.:?) L Node
x Text
key = L Node -> Parser (L Table)
forall (m :: * -> *). TomlParse m => L Node -> m (L Table)
pTable L Node
x Parser (L Table)
-> (L Table -> Parser (Maybe b)) -> Parser (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (L Node -> Parser b) -> Maybe (L Node) -> Parser (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse L Node -> Parser b
forall a b. FromToml a b => L a -> Parser b
fromToml (Maybe (L Node) -> Parser (Maybe b))
-> (L Table -> Maybe (L Node)) -> L Table -> Parser (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L (Maybe Node) -> Maybe (L Node)
forall a. L (Maybe a) -> Maybe (L a)
liftMaybe (L (Maybe Node) -> Maybe (L Node))
-> (L Table -> L (Maybe Node)) -> L Table -> Maybe (L Node)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> L Table -> L (Maybe Node)
pKeyMaybe Text
key

instance a ~ L Node => Index (Parser a) where
  {-# INLINE (.:)  #-}
  {-# INLINE (.:?) #-}
  .: :: Parser a -> Text -> Parser b
(.:)  Parser a
x Text
key = Parser a
x Parser a -> (a -> Parser (L Table)) -> Parser (L Table)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Parser (L Table)
forall (m :: * -> *). TomlParse m => L Node -> m (L Table)
pTable Parser (L Table) -> (L Table -> Parser (L Node)) -> Parser (L Node)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> L Table -> Parser (L Node)
forall (m :: * -> *). TomlParse m => Text -> L Table -> m (L Node)
pKey Text
key Parser (L Node) -> (L Node -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= L Node -> Parser b
forall a b. FromToml a b => L a -> Parser b
fromToml
  .:? :: Parser a -> Text -> Parser (Maybe b)
(.:?) Parser a
x Text
key = Parser a
x Parser a -> (a -> Parser (L Table)) -> Parser (L Table)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Parser (L Table)
forall (m :: * -> *). TomlParse m => L Node -> m (L Table)
pTable Parser (L Table)
-> (L Table -> Parser (Maybe b)) -> Parser (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (L Node -> Parser b) -> Maybe (L Node) -> Parser (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse L Node -> Parser b
forall a b. FromToml a b => L a -> Parser b
fromToml (Maybe (L Node) -> Parser (Maybe b))
-> (L Table -> Maybe (L Node)) -> L Table -> Parser (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L (Maybe Node) -> Maybe (L Node)
forall a. L (Maybe a) -> Maybe (L a)
liftMaybe (L (Maybe Node) -> Maybe (L Node))
-> (L Table -> L (Maybe Node)) -> L Table -> Maybe (L Node)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> L Table -> L (Maybe Node)
pKeyMaybe Text
key

-- | Assign default value to a parser that produces 'Maybe'. Typically used together with '.:?':
--
-- > foo .:? "bar" .!= 10
{-# INLINE (.!=) #-}
(.!=) :: Functor m => m (Maybe a) -> a -> m a
.!= :: m (Maybe a) -> a -> m a
(.!=) m (Maybe a)
action a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> m (Maybe a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
action

pTable :: TomlParse m => L Node -> m (L Table)
pTable :: L Node -> m (L Table)
pTable = \case
  L ParseEnv
env (VTable Table
x)   -> L Table -> m (L Table)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L Table -> m (L Table)) -> L Table -> m (L Table)
forall a b. (a -> b) -> a -> b
$ ParseEnv -> Table -> L Table
forall a. ParseEnv -> a -> L a
L ParseEnv
env Table
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m (L Table)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (L Table)) -> AtomicTomlError -> m (L Table)
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TTable Node
other'

pKey :: TomlParse m => Text -> L Table -> m (L Node)
pKey :: Text -> L Table -> m (L Node)
pKey Text
key tab' :: L Table
tab'@(L ParseEnv
_ Table
tab) = case L (Maybe Node) -> Maybe (L Node)
forall a. L (Maybe a) -> Maybe (L a)
liftMaybe (L (Maybe Node) -> Maybe (L Node))
-> L (Maybe Node) -> Maybe (L Node)
forall a b. (a -> b) -> a -> b
$ Text -> L Table -> L (Maybe Node)
pKeyMaybe Text
key L Table
tab' of
  Just L Node
x  -> L Node -> m (L Node)
forall (f :: * -> *) a. Applicative f => a -> f a
pure L Node
x
  Maybe (L Node)
Nothing -> L Table -> AtomicTomlError -> m (L Node)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Table
tab' (AtomicTomlError -> m (L Node)) -> AtomicTomlError -> m (L Node)
forall a b. (a -> b) -> a -> b
$ Text -> Table -> AtomicTomlError
MissingKey Text
key Table
tab

pKeyMaybe :: Text -> L Table -> L (Maybe Node)
pKeyMaybe :: Text -> L Table -> L (Maybe Node)
pKeyMaybe Text
key (L ParseEnv
env Table
tab) = ParseEnv -> Maybe Node -> L (Maybe Node)
forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Text -> TomlPath
PathKey Text
key) ParseEnv
env) (Maybe Node -> L (Maybe Node)) -> Maybe Node -> L (Maybe Node)
forall a b. (a -> b) -> a -> b
$ Text -> Table -> Maybe Node
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key Table
tab

pStr :: TomlParse m => L Node -> m Text
pStr :: L Node -> m Text
pStr = (L Text -> Text) -> m (L Text) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap L Text -> Text
forall (w :: * -> *) a. Comonad w => w a -> a
extract (m (L Text) -> m Text)
-> (L Node -> m (L Text)) -> L Node -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L Node -> m (L Text)
forall (m :: * -> *). TomlParse m => L Node -> m (L Text)
pStrL

pStrL :: TomlParse m => L Node -> m (L Text)
pStrL :: L Node -> m (L Text)
pStrL = \case
  L ParseEnv
env (VString Text
x)  -> L Text -> m (L Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L Text -> m (L Text)) -> L Text -> m (L Text)
forall a b. (a -> b) -> a -> b
$ ParseEnv -> Text -> L Text
forall a. ParseEnv -> a -> L a
L ParseEnv
env Text
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m (L Text)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (L Text)) -> AtomicTomlError -> m (L Text)
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TString Node
other'

pBool :: TomlParse m => L Node -> m Bool
pBool :: L Node -> m Bool
pBool = \case
  L ParseEnv
_ (VBoolean Bool
x)   -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m Bool
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m Bool) -> AtomicTomlError -> m Bool
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TBoolean Node
other'

pInt :: TomlParse m => L Node -> m Int
pInt :: L Node -> m Int
pInt = (L Int -> Int) -> m (L Int) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap L Int -> Int
forall (w :: * -> *) a. Comonad w => w a -> a
extract (m (L Int) -> m Int) -> (L Node -> m (L Int)) -> L Node -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L Node -> m (L Int)
forall (m :: * -> *). TomlParse m => L Node -> m (L Int)
pIntL

pIntL :: TomlParse m => L Node -> m (L Int)
pIntL :: L Node -> m (L Int)
pIntL = \case
  L ParseEnv
env (VInteger Int64
x) -> L Int -> m (L Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L Int -> m (L Int)) -> L Int -> m (L Int)
forall a b. (a -> b) -> a -> b
$ ParseEnv -> Int -> L Int
forall a. ParseEnv -> a -> L a
L ParseEnv
env (Int -> L Int) -> Int -> L Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m (L Int)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (L Int)) -> AtomicTomlError -> m (L Int)
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TInteger Node
other'

pDouble :: TomlParse m => L Node -> m Double
pDouble :: L Node -> m Double
pDouble = (L Double -> Double) -> m (L Double) -> m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap L Double -> Double
forall (w :: * -> *) a. Comonad w => w a -> a
extract (m (L Double) -> m Double)
-> (L Node -> m (L Double)) -> L Node -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L Node -> m (L Double)
forall (m :: * -> *). TomlParse m => L Node -> m (L Double)
pDoubleL

pDoubleL :: TomlParse m => L Node -> m (L Double)
pDoubleL :: L Node -> m (L Double)
pDoubleL = \case
  L ParseEnv
env (VFloat Double
x)   -> L Double -> m (L Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L Double -> m (L Double)) -> L Double -> m (L Double)
forall a b. (a -> b) -> a -> b
$ ParseEnv -> Double -> L Double
forall a. ParseEnv -> a -> L a
L ParseEnv
env Double
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m (L Double)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (L Double))
-> AtomicTomlError -> m (L Double)
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TFloat Node
other'

pDatetime :: TomlParse m => L Node -> m UTCTime
pDatetime :: L Node -> m UTCTime
pDatetime = (L UTCTime -> UTCTime) -> m (L UTCTime) -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap L UTCTime -> UTCTime
forall (w :: * -> *) a. Comonad w => w a -> a
extract (m (L UTCTime) -> m UTCTime)
-> (L Node -> m (L UTCTime)) -> L Node -> m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L Node -> m (L UTCTime)
forall (m :: * -> *). TomlParse m => L Node -> m (L UTCTime)
pDatetimeL

pDatetimeL :: TomlParse m => L Node -> m (L UTCTime)
pDatetimeL :: L Node -> m (L UTCTime)
pDatetimeL = \case
  L ParseEnv
env (VDatetime UTCTime
x) -> L UTCTime -> m (L UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L UTCTime -> m (L UTCTime)) -> L UTCTime -> m (L UTCTime)
forall a b. (a -> b) -> a -> b
$ ParseEnv -> UTCTime -> L UTCTime
forall a. ParseEnv -> a -> L a
L ParseEnv
env UTCTime
x
  other :: L Node
other@(L ParseEnv
_ Node
other')  -> L Node -> AtomicTomlError -> m (L UTCTime)
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (L UTCTime))
-> AtomicTomlError -> m (L UTCTime)
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TDatetime Node
other'

pTArray :: TomlParse m => L Node -> m (Vector (L Table))
pTArray :: L Node -> m (Vector (L Table))
pTArray = \case
  L ParseEnv
env (VTArray VTArray
x)  -> Vector (L Table) -> m (Vector (L Table))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (L Table) -> m (Vector (L Table)))
-> Vector (L Table) -> m (Vector (L Table))
forall a b. (a -> b) -> a -> b
$ (\(Int
n, Table
x') -> ParseEnv -> Table -> L Table
forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Int -> TomlPath
PathIndex Int
n) ParseEnv
env) Table
x') ((Int, Table) -> L Table)
-> Vector (Int, Table) -> Vector (L Table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VTArray -> Vector (Int, Table)
forall a. Vector a -> Vector (Int, a)
V.indexed VTArray
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m (Vector (L Table))
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (Vector (L Table)))
-> AtomicTomlError -> m (Vector (L Table))
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TTArray Node
other'

pArray :: TomlParse m => L Node -> m (Vector (L Node))
pArray :: L Node -> m (Vector (L Node))
pArray = \case
  L ParseEnv
env (VArray VArray
x)   -> Vector (L Node) -> m (Vector (L Node))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (L Node) -> m (Vector (L Node)))
-> Vector (L Node) -> m (Vector (L Node))
forall a b. (a -> b) -> a -> b
$ (\(Int
n, Node
x') -> ParseEnv -> Node -> L Node
forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Int -> TomlPath
PathIndex Int
n) ParseEnv
env) Node
x') ((Int, Node) -> L Node) -> Vector (Int, Node) -> Vector (L Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VArray -> Vector (Int, Node)
forall a. Vector a -> Vector (Int, a)
V.indexed VArray
x
  other :: L Node
other@(L ParseEnv
_ Node
other') -> L Node -> AtomicTomlError -> m (Vector (L Node))
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
other (AtomicTomlError -> m (Vector (L Node)))
-> AtomicTomlError -> m (Vector (L Node))
forall a b. (a -> b) -> a -> b
$ TomlType -> Node -> AtomicTomlError
UnexpectedType TomlType
TArray Node
other'

{-# INLINE pCases #-}
pCases :: (Ord k, FromToml Node k, Pretty k) => Map k v -> L Node -> Parser v
pCases :: Map k v -> L Node -> Parser v
pCases Map k v
env = \L Node
x -> do
  k
k <- L Node -> Parser k
forall a b. FromToml a b => L a -> Parser b
fromToml L Node
x
  case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k v
env of
    Just v
v  -> v -> Parser v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
    Maybe v
Nothing -> L Node -> AtomicTomlError -> Parser v
forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Node
x (AtomicTomlError -> Parser v) -> AtomicTomlError -> Parser v
forall a b. (a -> b) -> a -> b
$ Doc Void -> AtomicTomlError
OtherError (Doc Void -> AtomicTomlError) -> Doc Void -> AtomicTomlError
forall a b. (a -> b) -> a -> b
$
      Doc Void
"Unexpected value" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (k -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty k
k) Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
"." Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      Doc Void
"Expected one of" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep (Doc Void -> [Doc Void] -> [Doc Void]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc Void
"," ((k -> Doc Void) -> [k] -> [Doc Void]
forall a b. (a -> b) -> [a] -> [b]
map k -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (Map k v -> [k]
forall k a. Map k a -> [k]
M.keys Map k v
env)))

liftMaybe :: L (Maybe a) -> Maybe (L a)
liftMaybe :: L (Maybe a) -> Maybe (L a)
liftMaybe (L ParseEnv
env Maybe a
x) = ParseEnv -> a -> L a
forall a. ParseEnv -> a -> L a
L ParseEnv
env (a -> L a) -> Maybe a -> Maybe (L a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
x