----------------------------------------------------------------------------
-- |
-- 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               #-}
{-# LANGUAGE TypeOperators              #-}

module TOML.Parse
  ( Value(..)
  , Parser
  , runParser
  , mkTomlError
  , AtomicTomlError(..)
  , TomlError
  , (<?>)
  , L
  , extract
  , TomlParse(..)
  , FromToml(..)
  , Index(..)
  , (.!=)
  , pTable
  , pTableL
  , pKey
  , pKeyMaybe
  , pStr
  , pStrL
  , pBool
  , pInt
  , pIntL
  , pDouble
  , pDoubleL
  , pArray
  , TomlDateTime(..)
  , pDatetime
  , pDatetimeL
  , pCases
  , ppToml
  ) where

import Control.Applicative
import Control.Comonad
import Control.DeepSeq
import Control.Monad

import Data.Bifunctor
import Data.DList (DList)
import Data.DList qualified as DL
import Data.Foldable
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 qualified as Time
import Data.Time.Format.ISO8601 qualified as Time
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 TOML

import Unsafe.Coerce

data TomlType
  = TTable
  | TArray
  | TString
  | TInteger
  | TFloat
  | TBoolean
  | TDatetime
  deriving (TomlType -> TomlType -> Bool
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
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
Ord, Int -> TomlType -> ShowS
[TomlType] -> ShowS
TomlType -> String
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. 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 :: Value -> TomlType
getType :: Value -> TomlType
getType = \case
  Table{}          -> TomlType
TTable
  Array{}          -> TomlType
TArray
  String{}         -> TomlType
TString
  Integer{}        -> TomlType
TInteger
  Float{}          -> TomlType
TFloat
  Boolean{}        -> TomlType
TBoolean
  OffsetDateTime{} -> TomlType
TDatetime
  LocalDateTime{}  -> TomlType
TDatetime
  LocalDate{}      -> TomlType
TDatetime
  LocalTime{}      -> TomlType
TDatetime

ppTomlType :: TomlType -> (Doc ann, Doc ann)
ppTomlType :: forall ann. TomlType -> (Doc ann, Doc ann)
ppTomlType = \case
  TomlType
TTable    -> (Doc ann
"a",  Doc ann
"table")
  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
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
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
Ord, Int -> TomlPath -> ShowS
[TomlPath] -> ShowS
TomlPath -> String
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. 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 :: forall ann. TomlPath -> Doc ann
pretty = \case
    PathIndex Int
n     -> Doc ann
"In array element" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
n
    PathKey Text
str     -> Doc ann
"In table key" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Text
str)
    PathOther Text
thing -> Doc ann
"While parsing" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
thing

data AtomicTomlError
  = UnexpectedType
      !TomlType -- ^ Expected
      Value     -- ^ Got
  | MissingKey !Text Table
  | IndexOutOfBounds !Int Value
  | OtherError (Doc Void)
  deriving (Int -> AtomicTomlError -> ShowS
[AtomicTomlError] -> ShowS
AtomicTomlError -> String
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. 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 :: Value -> Doc ann
ppToml :: forall ann. Value -> Doc ann
ppToml = \case
  Table    Table
x       -> forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> Map k v -> Doc ann
ppMapWith forall a ann. Pretty a => a -> Doc ann
pretty forall ann. Value -> Doc ann
ppToml Table
x
  String   Text
x       -> forall a ann. Pretty a => a -> Doc ann
pretty Text
x
  Integer  Integer
x       -> forall a ann. Pretty a => a -> Doc ann
pretty Integer
x
  Float    Double
x       -> forall a ann. Pretty a => a -> Doc ann
pretty Double
x
  Boolean  Bool
x       -> forall a ann. Pretty a => a -> Doc ann
pretty Bool
x
  LocalDateTime LocalTime
x  -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ LocalTime -> TomlDateTime
TomlLocalDateTime LocalTime
x
  OffsetDateTime (LocalTime, TimeZone)
x -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ (LocalTime, TimeZone) -> TomlDateTime
TomlOffsetDateTime (LocalTime, TimeZone)
x
  LocalDate Day
x      -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Day -> TomlDateTime
TomlLocalDate Day
x
  LocalTime TimeOfDay
x      -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ TimeOfDay -> TomlDateTime
TomlLocalTime TimeOfDay
x
  Array    [Value]
xs      -> forall a ann. (a -> Doc ann) -> [a] -> Doc ann
ppListWith forall ann. Value -> Doc ann
ppToml [Value]
xs

instance Pretty AtomicTomlError where
  pretty :: forall ann. AtomicTomlError -> Doc ann
pretty = \case
    UnexpectedType TomlType
expected Value
got ->
      Doc ann
"Expected to find" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
article forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
typ forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"but found" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
article' forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
typ' forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      Doc ann
"Value:" forall ann. Doc ann -> Doc ann -> Doc ann
## forall ann. Value -> Doc ann
ppToml Value
got
      where
        (Doc ann
article,  Doc ann
typ)  = forall ann. TomlType -> (Doc ann, Doc ann)
ppTomlType TomlType
expected
        (Doc ann
article', Doc ann
typ') = forall ann. TomlType -> (Doc ann, Doc ann)
ppTomlType forall a b. (a -> b) -> a -> b
$ Value -> TomlType
getType Value
got
    MissingKey Text
key Table
tab          -> Doc ann
"Missing key" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Text
key) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in table:" forall ann. Doc ann -> Doc ann -> Doc ann
## forall k ann v.
(k -> Doc ann) -> (v -> Doc ann) -> Map k v -> Doc ann
ppMapWith forall a ann. Pretty a => a -> Doc ann
pretty forall ann. Value -> Doc ann
ppToml Table
tab
    IndexOutOfBounds Int
ix Value
node    -> Doc ann
"Index" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
ix forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is out of bounds in array:" forall ann. Doc ann -> Doc ann -> Doc ann
## forall ann. Value -> Doc ann
ppToml Value
node
    OtherError Doc Void
err              -> Doc ann
"Other error:" forall ann. Doc ann -> Doc ann -> 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
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. 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 :: forall ann. TomlError -> Doc ann
pretty = \case
    TomlError
ErrorEmpty       -> Doc ann
"Control.Applicative.empty"
    ErrorAtomic AtomicTomlError
err  -> forall a ann. Pretty a => a -> Doc ann
pretty AtomicTomlError
err
    ErrorAnd TomlError
x TomlError
y     -> Doc ann
"AND" forall ann. Doc ann -> Doc ann -> Doc ann
## forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
x TomlError
y)
    ErrorOr  TomlError
x TomlError
y     -> Doc ann
"OR"  forall ann. Doc ann -> Doc ann -> Doc ann
## forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
x TomlError
y)
    ErrorPrefix NonEmpty TomlPath
ps TomlError
e -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TomlPath
p Doc ann
acc -> forall a ann. Pretty a => a -> Doc ann
pretty TomlPath
p forall ann. Doc ann -> Doc ann -> Doc ann
## Doc ann
acc) (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 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 forall a. Semigroup a => a -> a -> a
<> forall a. a -> DList a
DL.singleton TomlError
c
      collectConjuctions TomlError
a              (ErrorAnd TomlError
c TomlError
d) = forall a. a -> DList a
DL.singleton TomlError
a forall a. Semigroup a => a -> a -> a
<> TomlError -> TomlError -> DList TomlError
collectConjuctions TomlError
c TomlError
d
      collectConjuctions TomlError
a              TomlError
c              = 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 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 forall a. Semigroup a => a -> a -> a
<> forall a. a -> DList a
DL.singleton TomlError
c
      collectDisjunctions TomlError
a             (ErrorOr TomlError
c TomlError
d) = forall a. a -> DList a
DL.singleton TomlError
a forall a. Semigroup a => a -> a -> a
<> TomlError -> TomlError -> DList TomlError
collectDisjunctions TomlError
c TomlError
d
      collectDisjunctions TomlError
a             TomlError
c             = 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
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
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
Ord, Int -> IsCommitted -> ShowS
[IsCommitted] -> ShowS
IsCommitted -> String
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]
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
forall a. a -> a -> Bounded a
maxBound :: IsCommitted
$cmaxBound :: IsCommitted
minBound :: IsCommitted
$cminBound :: IsCommitted
Bounded)

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

newtype Validation a = Validation
  { forall a. Validation a -> Either (IsCommitted, TomlError) a
unValidation :: Either (IsCommitted, TomlError) a }
  deriving (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
<$ :: forall a b. a -> Validation b -> Validation a
$c<$ :: forall a b. a -> Validation b -> Validation a
fmap :: forall a b. (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') ->
    forall a b c. (a -> b -> c) -> b -> a -> c
flip 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) 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 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)
_ -> 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 forall a. Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
go' [] (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TomlPath
xs) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TomlPath
ys) of
        (TomlPath
c : [TomlPath]
cs, [TomlPath]
xs', [TomlPath]
ys') -> forall a. a -> Maybe a
Just (TomlPath
c forall a. a -> [a] -> NonEmpty a
:| [TomlPath]
cs, [TomlPath]
xs', [TomlPath]
ys')
        ([TomlPath], [TomlPath], [TomlPath])
_                  -> forall a. Maybe a
Nothing
    go' :: Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
    go' :: forall a. Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
go' [a]
common (a
a : [a]
as) (a
b : [a]
bs)
      | a
a forall a. Eq a => a -> a -> Bool
== a
b = forall a. Eq a => [a] -> [a] -> [a] -> ([a], [a], [a])
go' (a
a forall a. a -> [a] -> [a]
: [a]
common) [a]
as [a]
bs
    go' [a]
common [a]
as [a]
bs = (forall a. [a] -> [a]
reverse [a]
common, [a]
as, [a]
bs)

instance Applicative Validation where
  {-# INLINE pure #-}
  pure :: forall a. a -> Validation a
pure = forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# NOINLINE (<*>) #-}
  <*> :: forall a b. 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)) -> forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (IsCommitted
cf 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
_)             -> forall a b. a -> b
unsafeCoerce Validation (a -> b)
vf'
      (Either (IsCommitted, TomlError) (a -> b)
_,             Left (IsCommitted, TomlError)
_)        -> forall a b. a -> b
unsafeCoerce Validation a
vx'
      (Right a -> b
f,       Right a
x)       -> forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Alternative Validation where
  {-# INLINE empty #-}
  empty :: forall a. Validation a
empty = forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (IsCommitted
Uncommitted, TomlError
ErrorEmpty)
  {-# NOINLINE (<|>) #-}
  <|> :: forall a. 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)
_                          -> forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (IsCommitted
cf 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 (>>)  #-}
  >>= :: forall a b. 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)
_ -> forall a b. a -> b
unsafeCoerce Validation a
x'
      Right a
y -> forall {a}. Validation a -> Validation a
commit 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))) = forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (IsCommitted
Committed, TomlError
err)
      commit z :: Validation a
z@(Validation (Right a
_))     = Validation a
z
  >> :: forall a 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
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
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
Ord, Int -> ParseEnv -> ShowS
[ParseEnv] -> ShowS
ParseEnv -> String
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. 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, 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 :: forall ann. [ParseEnv] -> Doc ann
$cprettyList :: forall ann. [ParseEnv] -> Doc ann
pretty :: forall ann. ParseEnv -> Doc ann
$cpretty :: forall ann. ParseEnv -> Doc ann
Pretty)

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

instance Monad Parser where
  {-# INLINE (>>=) #-}
  {-# INLINE (>>)  #-}
  >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
(>>=) (Parser Validation a
x) a -> Parser b
f = forall a. Validation a -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ do
    a
x' <- Validation a
x
    forall a. Parser a -> Validation a
unParser forall a b. (a -> b) -> a -> b
$ a -> Parser b
f a
x'
  >> :: forall a 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
<?> :: forall a. L a -> Text -> L a
(<?>) (L ParseEnv
env a
x) Text
y = 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 :: forall b a. L b -> AtomicTomlError -> Parser a
throwParseError L b
loc AtomicTomlError
err = forall a. Validation a -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall a. Either (IsCommitted, TomlError) a -> Validation a
Validation forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (IsCommitted
Uncommitted, forall a. L a -> AtomicTomlError -> TomlError
mkTomlError' L b
loc AtomicTomlError
err)

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

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

mkTomlError' :: L a -> AtomicTomlError -> TomlError
mkTomlError' :: forall a. L a -> AtomicTomlError -> TomlError
mkTomlError' (L ParseEnv
env a
_) AtomicTomlError
err = case forall a. [a] -> [a]
reverse 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 forall a. a -> [a] -> NonEmpty a
:| [TomlPath]
ps) 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
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, L a -> L a -> Bool
L a -> L a -> Ordering
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
Ord, Int -> L a -> ShowS
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, 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
<$ :: forall a b. a -> L b -> L a
$c<$ :: forall a b. a -> L b -> L a
fmap :: forall a b. (a -> b) -> L a -> L b
$cfmap :: forall a b. (a -> b) -> L a -> L b
Functor, 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 :: forall a. Num a => L a -> a
$cproduct :: forall a. Num a => L a -> a
sum :: forall a. Num a => L a -> a
$csum :: forall a. Num a => L a -> a
minimum :: forall a. Ord a => L a -> a
$cminimum :: forall a. Ord a => L a -> a
maximum :: forall a. Ord a => L a -> a
$cmaximum :: forall a. Ord a => L a -> a
elem :: forall a. Eq a => a -> L a -> Bool
$celem :: forall a. Eq a => a -> L a -> Bool
length :: forall a. L a -> Int
$clength :: forall a. L a -> Int
null :: forall a. L a -> Bool
$cnull :: forall a. L a -> Bool
toList :: forall a. L a -> [a]
$ctoList :: forall a. L a -> [a]
foldl1 :: forall a. (a -> a -> a) -> L a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> L a -> a
foldr1 :: forall a. (a -> a -> a) -> L a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> L a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> L a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> L a -> b
foldl :: forall b a. (b -> a -> b) -> b -> L a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> L a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> L a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> L a -> b
foldr :: forall a b. (a -> b -> b) -> b -> L a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> L a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> L a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> L a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> L a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> L a -> m
fold :: forall m. Monoid m => L m -> m
$cfold :: forall m. Monoid m => L m -> m
Foldable, Functor L
Foldable L
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 :: forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
$csequence :: forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
sequenceA :: forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
Traversable, 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 :: forall ann. L a -> Doc ann
pretty = forall a ann. (Generic a, GPretty (Rep a)) => a -> Doc ann
ppGeneric

instance Comonad L where
  {-# INLINE extract   #-}
  {-# INLINE duplicate #-}
  extract :: forall a. L a -> a
extract (L ParseEnv
_ a
x) = a
x
  duplicate :: forall a. L a -> L (L a)
duplicate orig :: L a
orig@(L ParseEnv
env 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 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 b a => FromToml b (L a) where
  {-# INLINE fromToml #-}
  fromToml :: L b -> Parser (L a)
fromToml b :: L b
b@(L ParseEnv
env b
_) = forall a. ParseEnv -> a -> L a
L ParseEnv
env forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. FromToml a b => L a -> Parser b
fromToml L b
b

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance a ~ L Value => Index (Parser a) where
  {-# INLINE (.:)  #-}
  {-# INLINE (.:?) #-}
  .: :: forall b. FromToml Value b => Parser a -> Text -> Parser b
(.:)  Parser a
x Text
key = Parser a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). TomlParse m => L Value -> m (L Table)
pTableL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). TomlParse m => Text -> L Table -> m (L Value)
pKey Text
key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. FromToml a b => L a -> Parser b
fromToml
  .:? :: forall b. FromToml Value b => Parser a -> Text -> Parser (Maybe b)
(.:?) Parser a
x Text
key = Parser a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). TomlParse m => L Value -> m (L Table)
pTableL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. FromToml a b => L a -> Parser b
fromToml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. L (Maybe a) -> Maybe (L a)
liftMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> L Table -> L (Maybe Value)
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
.!= :: forall (m :: * -> *) a. Functor m => m (Maybe a) -> a -> m a
(.!=) m (Maybe a)
action a
def = forall a. a -> Maybe a -> a
fromMaybe a
def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
action

pTable :: TomlParse m => L Value -> m Table
pTable :: forall (m :: * -> *). TomlParse m => L Value -> m Table
pTable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (w :: * -> *) a. Comonad w => w a -> a
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). TomlParse m => L Value -> m (L Table)
pTableL

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

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

pKeyMaybe :: Text -> L Table -> L (Maybe Value)
pKeyMaybe :: Text -> L Table -> L (Maybe Value)
pKeyMaybe Text
key (L ParseEnv
env Table
tab) = forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Text -> TomlPath
PathKey Text
key) ParseEnv
env) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Table
tab

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

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

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

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

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

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

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

data TomlDateTime
  = TomlLocalDateTime Time.LocalTime
  | TomlOffsetDateTime (Time.LocalTime, Time.TimeZone)
  | TomlLocalDate Time.Day
  | TomlLocalTime Time.TimeOfDay
  deriving (TomlDateTime -> TomlDateTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlDateTime -> TomlDateTime -> Bool
$c/= :: TomlDateTime -> TomlDateTime -> Bool
== :: TomlDateTime -> TomlDateTime -> Bool
$c== :: TomlDateTime -> TomlDateTime -> Bool
Eq, Eq TomlDateTime
TomlDateTime -> TomlDateTime -> Bool
TomlDateTime -> TomlDateTime -> Ordering
TomlDateTime -> TomlDateTime -> TomlDateTime
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 :: TomlDateTime -> TomlDateTime -> TomlDateTime
$cmin :: TomlDateTime -> TomlDateTime -> TomlDateTime
max :: TomlDateTime -> TomlDateTime -> TomlDateTime
$cmax :: TomlDateTime -> TomlDateTime -> TomlDateTime
>= :: TomlDateTime -> TomlDateTime -> Bool
$c>= :: TomlDateTime -> TomlDateTime -> Bool
> :: TomlDateTime -> TomlDateTime -> Bool
$c> :: TomlDateTime -> TomlDateTime -> Bool
<= :: TomlDateTime -> TomlDateTime -> Bool
$c<= :: TomlDateTime -> TomlDateTime -> Bool
< :: TomlDateTime -> TomlDateTime -> Bool
$c< :: TomlDateTime -> TomlDateTime -> Bool
compare :: TomlDateTime -> TomlDateTime -> Ordering
$ccompare :: TomlDateTime -> TomlDateTime -> Ordering
Ord, Int -> TomlDateTime -> ShowS
[TomlDateTime] -> ShowS
TomlDateTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TomlDateTime] -> ShowS
$cshowList :: [TomlDateTime] -> ShowS
show :: TomlDateTime -> String
$cshow :: TomlDateTime -> String
showsPrec :: Int -> TomlDateTime -> ShowS
$cshowsPrec :: Int -> TomlDateTime -> ShowS
Show, forall x. Rep TomlDateTime x -> TomlDateTime
forall x. TomlDateTime -> Rep TomlDateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TomlDateTime x -> TomlDateTime
$cfrom :: forall x. TomlDateTime -> Rep TomlDateTime x
Generic)

instance NFData TomlDateTime

instance Pretty TomlDateTime where
  pretty :: forall ann. TomlDateTime -> Doc ann
pretty (TomlLocalDateTime LocalTime
t)        = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall t. ISO8601 t => t -> String
Time.iso8601Show LocalTime
t
  pretty (TomlOffsetDateTime (LocalTime
t, TimeZone
tz)) = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall t. ISO8601 t => t -> String
Time.iso8601Show forall a b. (a -> b) -> a -> b
$ TimeZone -> LocalTime -> UTCTime
Time.localTimeToUTC TimeZone
tz LocalTime
t
  pretty (TomlLocalDate Day
t)            = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall t. ISO8601 t => t -> String
Time.iso8601Show Day
t
  pretty (TomlLocalTime TimeOfDay
t)            = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall t. ISO8601 t => t -> String
Time.iso8601Show TimeOfDay
t

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

pDatetimeL :: TomlParse m => L Value -> m (L TomlDateTime)
pDatetimeL :: forall (m :: * -> *). TomlParse m => L Value -> m (L TomlDateTime)
pDatetimeL = \case
  L ParseEnv
env (LocalDateTime LocalTime
x)  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ParseEnv -> a -> L a
L ParseEnv
env forall a b. (a -> b) -> a -> b
$ LocalTime -> TomlDateTime
TomlLocalDateTime LocalTime
x
  L ParseEnv
env (OffsetDateTime (LocalTime, TimeZone)
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ParseEnv -> a -> L a
L ParseEnv
env forall a b. (a -> b) -> a -> b
$ (LocalTime, TimeZone) -> TomlDateTime
TomlOffsetDateTime (LocalTime, TimeZone)
x
  L ParseEnv
env (LocalDate Day
x)      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ParseEnv -> a -> L a
L ParseEnv
env forall a b. (a -> b) -> a -> b
$ Day -> TomlDateTime
TomlLocalDate Day
x
  L ParseEnv
env (LocalTime TimeOfDay
x)      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ParseEnv -> a -> L a
L ParseEnv
env forall a b. (a -> b) -> a -> b
$ TimeOfDay -> TomlDateTime
TomlLocalTime TimeOfDay
x
  other :: L Value
other@(L ParseEnv
_ Value
other')       -> forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Value
other forall a b. (a -> b) -> a -> b
$ TomlType -> Value -> AtomicTomlError
UnexpectedType TomlType
TDatetime Value
other'

pArray :: TomlParse m => L Value -> m [L Value]
pArray :: forall (m :: * -> *). TomlParse m => L Value -> m [L Value]
pArray = \case
  L ParseEnv
env (Array [Value]
x)    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\(Int
n, Value
x') -> forall a. ParseEnv -> a -> L a
L (TomlPath -> ParseEnv -> ParseEnv
inside (Int -> TomlPath
PathIndex Int
n) ParseEnv
env) Value
x') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Value]
x
  other :: L Value
other@(L ParseEnv
_ Value
other') -> forall (m :: * -> *) b a.
TomlParse m =>
L b -> AtomicTomlError -> m a
throwParseError L Value
other forall a b. (a -> b) -> a -> b
$ TomlType -> Value -> AtomicTomlError
UnexpectedType TomlType
TArray Value
other'

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

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