{-# LANGUAGE CPP               #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE Safe              #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- Document oriented [YAML](http://yaml.org/spec/1.2/spec.html) parsing API inspired by [aeson](http://hackage.haskell.org/package/aeson).

module Data.YAML
    (

      -- * Overview
      -- $overview

      -- * Quick Start Tutorial
      -- $start

      -- ** Decoding/Loading YAML document
      -- $loading

      -- ** Encoding/dumping
      -- $dumping

      -- * Typeclass-based resolving/decoding
      decode
    , decode1
    , decodeStrict
    , decode1Strict
    , FromYAML(..)
    , Parser
    , parseEither
    , failAtNode
    , typeMismatch

      -- ** Accessors for YAML t'Mapping's
    , Mapping
    , (.:), (.:?), (.:!), (.!=)

      -- * Typeclass-based dumping
    , encode
    , encode1
    , encodeStrict
    , encode1Strict
    , ToYAML(..)

      -- ** Accessors for encoding t'Mapping's
    , Pair
    , mapping
    , (.=)

      -- ** Prism-style parsers
    , withScalar
    , withSeq
    , withBool
    , withFloat
    , withInt
    , withNull
    , withStr
    , withMap

      -- * \"Concrete\" AST
    , decodeNode
    , decodeNode'
    , encodeNode
    , encodeNode'
    , Doc(Doc,docRoot)
    , Node(..)
    , Scalar(..)

      -- * Source locations
    , Pos(..)
    , prettyPosWithSource

      -- * YAML 1.2 Schema resolvers
      --
      -- | See also "Data.YAML.Schema"
    , SchemaResolver
    , failsafeSchemaResolver
    , jsonSchemaResolver
    , coreSchemaResolver

      -- * YAML 1.2 Schema encoders
      --
      -- | See also "Data.YAML.Schema"
    , SchemaEncoder
    , failsafeSchemaEncoder
    , jsonSchemaEncoder
    , coreSchemaEncoder

      -- * Generalised AST construction
    , decodeLoader
    , Loader(..)
    , LoaderT
    , NodeId

    ) where

import qualified Control.Monad.Fail        as Fail
import qualified Data.ByteString           as BS
import qualified Data.ByteString.Lazy      as BS.L
import qualified Data.Map                  as Map
import qualified Data.Text                 as T

import           Data.YAML.Dumper
import           Data.YAML.Event           (isUntagged, tagToText)
import           Data.YAML.Internal
import           Data.YAML.Loader
import           Data.YAML.Pos
import           Data.YAML.Schema.Internal

import           Util

-- $overview
--
-- The diagram below depicts the standard layers of a [YAML 1.2](http://yaml.org/spec/1.2/spec.html) processor. This module covers the upper /Native/ and /Representation/ layers, whereas the "Data.YAML.Event" and "Data.YAML.Token" modules provide access to the lower /Serialization/ and /Presentation/ layers respectively.
--
-- <<http://yaml.org/spec/1.2/overview2.png>>
--
-- $start
--
-- This section contains basic information on the different ways to work with YAML data using this library.
--
-- $loading
--
-- We address the process of loading data from a YAML document as decoding.
--
-- Let's assume we want to decode (i.e. /load/) a simple YAML document
--
-- > - name: Erik Weisz
-- >   age: 52
-- >   magic: True
-- > - name: Mina Crandon
-- >   age: 53
--
-- into a native Haskell data structure of type @[Person]@, i.e. a list of @Person@ records.
--
-- The code below shows how to manually define a @Person@ record type together with a 'FromYAML' instance:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Data.YAML
-- >
-- > data Person = Person
-- >     { name  :: Text
-- >     , age   :: Int
-- >     , magic :: Bool
-- >     } deriving Show
-- >
-- > instance FromYAML Person where
-- >    parseYAML = withMap "Person" $ \m -> Person
-- >        <$> m .: "name"
-- >        <*> m .: "age"
-- >        <*> m .:? "magic" .!= False
--
-- And now we can 'decode' the YAML document like so:
--
-- >>> decode "- name: Erik Weisz\n  age: 52\n  magic: True\n- name: Mina Crandon\n  age: 53" :: Either (Pos,String) [[Person]]
-- Right [[Person {name = "Erik Weisz", age = 52, magic = True},Person {name = "Mina Crandon", age = 53, magic = False}]]
--
-- There are predefined 'FromYAML' instance for many types.
--
-- The example below shows decoding multiple YAML documents into a list of 'Int' lists:
--
-- >>> decode "---\n- 1\n- 2\n- 3\n---\n- 4\n- 5\n- 6" :: Either (Pos,String) [[Int]]
-- Right [[1,2,3],[4,5,6]]
--
-- If you are expecting exactly one YAML document then you can use convenience function 'decode1'
--
-- >>> decode1 "- 1\n- 2\n- 3\n" :: Either (Pos,String) [Int]
-- Right [1,2,3]
--
-- == Working with AST
--
-- Sometimes we want to work with YAML data directly, without first converting it to a custom data type.
--
-- We can easily do that by using the 'Node' type, which is an instance of 'FromYAML', is used to represent an arbitrary YAML AST (abstract syntax tree). For example,
--
-- >>> decode1 "Name: Vijay" :: Either (Pos,String) (Node Pos)
-- Right (Mapping (Pos {posByteOffset = 0, posCharOffset = 0, posLine = 1, posColumn = 0}) Just "tag:yaml.org,2002:map" (fromList [(Scalar (Pos {posByteOffset = 0, posCharOffset = 0, posLine = 1, posColumn = 0}) (SStr "Name"),Scalar (Pos {posByteOffset = 6, posCharOffset = 6, posLine = 1, posColumn = 6}) (SStr "Vijay"))]))
--
-- The type parameter 'Pos' is used to indicate the position of each YAML 'Node' in the document.
-- So using the 'Node' type we can easily decode any YAML document.
--
-- == Pretty-printing source locations
--
-- Syntax errors or even conversion errors are reported with a source location, e.g.
--
-- >>> decode "- name: Erik Weisz\n  age: 52\n  magic: True\n- name: Mina Crandon\n  age: young" :: Either (Pos,String) [[Person]]
-- Left (Pos {posByteOffset = 71, posCharOffset = 71, posLine = 5, posColumn = 7},"expected !!int instead of !!str")
--
-- While accurate this isn't a very convenient error representation. Instead we can use the 'prettyPosWithSource' helper function to create more convenient error report like so
--
-- @
-- readPersons :: FilePath -> IO [Person]
-- readPersons fname = do
--    raw <- BS.L.readFile fname
--    case 'decode1' raw of
--      Left (loc,emsg) -> do
--        hPutStrLn stderr (fname ++ ":" ++ 'prettyPosWithSource' loc raw " error" ++ emsg)
--        pure []
--      Right persons -> pure persons
-- @
--
-- which will then print errors in a common form such as
--
-- > people.yaml:5:7: error
-- >    |
-- >  5 |   age: young
-- >    |        ^
-- > expected !!int instead of !!str
--


-- | Retrieve value in t'Mapping' indexed by a @!!str@ 'Text' key.
--
-- This parser fails if the key doesn't exist.
(.:) :: FromYAML a => Mapping Pos -> Text -> Parser a
Mapping Pos
m .: :: Mapping Pos -> Text -> Parser a
.: Text
k = Parser a -> (Node Pos -> Parser a) -> Maybe (Node Pos) -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found") Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML (Node Pos -> Mapping Pos -> Maybe (Node Pos)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
Scalar Pos
fakePos (Text -> Scalar
SStr Text
k)) Mapping Pos
m)

-- | Retrieve optional value in t'Mapping' indexed by a @!!str@ 'Text' key.
--
-- 'Nothing' is returned if the key is missing or points to a @tag:yaml.org,2002:null@ node.
-- This combinator only fails if the key exists but cannot be converted to the required type.
--
-- See also '.:!'.
(.:?) :: FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
Mapping Pos
m .:? :: Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
k = Parser (Maybe a)
-> (Node Pos -> Parser (Maybe a))
-> Maybe (Node Pos)
-> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) Node Pos -> Parser (Maybe a)
forall a. FromYAML a => Node Pos -> Parser a
parseYAML (Node Pos -> Mapping Pos -> Maybe (Node Pos)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
Scalar Pos
fakePos (Text -> Scalar
SStr Text
k)) Mapping Pos
m)

-- | Retrieve optional value in t'Mapping' indexed by a @!!str@ 'Text' key.
--
-- 'Nothing' is returned if the key is missing.
-- This combinator only fails if the key exists but cannot be converted to the required type.
--
-- __NOTE__: This is a variant of '.:?' which doesn't map a @tag:yaml.org,2002:null@ node to 'Nothing'.
(.:!) :: FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
Mapping Pos
m .:! :: Mapping Pos -> Text -> Parser (Maybe a)
.:! Text
k = Parser (Maybe a)
-> (Node Pos -> Parser (Maybe a))
-> Maybe (Node Pos)
-> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Parser a -> Parser (Maybe a))
-> (Node Pos -> Parser a) -> Node Pos -> Parser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML) (Node Pos -> Mapping Pos -> Maybe (Node Pos)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
Scalar Pos
fakePos (Text -> Scalar
SStr Text
k)) Mapping Pos
m)

-- | Defaulting helper to be used with '.:?' or '.:!'.
(.!=) :: Parser (Maybe a) -> a -> Parser a
Parser (Maybe a)
mv .!= :: Parser (Maybe a) -> a -> Parser a
.!= a
def = (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def a -> a
forall a. a -> a
id) Parser (Maybe a)
mv

fakePos :: Pos
fakePos :: Pos
fakePos = Pos :: Int -> Int -> Int -> Int -> Pos
Pos { posByteOffset :: Int
posByteOffset = -Int
1 , posCharOffset :: Int
posCharOffset = -Int
1  , posLine :: Int
posLine = Int
1 , posColumn :: Int
posColumn = Int
0 }

-- | Parse and decode YAML document(s) into 'Node' graphs
--
-- This is a convenience wrapper over `decodeNode'`, i.e.
--
-- @
-- decodeNode = decodeNode' 'coreSchemaResolver' False False
-- @
--
-- In other words,
--
-- * Use the YAML 1.2 Core schema for resolving
-- * Don't create 'Anchor' nodes
-- * Disallow cyclic anchor references
--
-- @since 0.2.0
--
decodeNode :: BS.L.ByteString -> Either (Pos, String) [Doc (Node Pos)]
decodeNode :: ByteString -> Either (Pos, String) [Doc (Node Pos)]
decodeNode = SchemaResolver
-> Bool
-> Bool
-> ByteString
-> Either (Pos, String) [Doc (Node Pos)]
decodeNode' SchemaResolver
coreSchemaResolver Bool
False Bool
False


-- | Customizable variant of 'decodeNode'
--
-- @since 0.2.0
--
decodeNode' :: SchemaResolver  -- ^ YAML Schema resolver to use
            -> Bool            -- ^ Whether to emit anchor nodes
            -> Bool            -- ^ Whether to allow cyclic references
            -> BS.L.ByteString -- ^ YAML document to parse
            -> Either (Pos, String) [Doc (Node Pos)]
decodeNode' :: SchemaResolver
-> Bool
-> Bool
-> ByteString
-> Either (Pos, String) [Doc (Node Pos)]
decodeNode' SchemaResolver{Bool
Tag -> Either String Tag
Tag -> ScalarStyle -> Text -> Either String Scalar
schemaResolverMappingDuplicates :: SchemaResolver -> Bool
schemaResolverMapping :: SchemaResolver -> Tag -> Either String Tag
schemaResolverSequence :: SchemaResolver -> Tag -> Either String Tag
schemaResolverScalar :: SchemaResolver
-> Tag -> ScalarStyle -> Text -> Either String Scalar
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: Tag -> Either String Tag
schemaResolverSequence :: Tag -> Either String Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either String Scalar
..} Bool
anchorNodes Bool
allowCycles ByteString
bs0
  = (Node Pos -> Doc (Node Pos)) -> [Node Pos] -> [Doc (Node Pos)]
forall a b. (a -> b) -> [a] -> [b]
map Node Pos -> Doc (Node Pos)
forall n. n -> Doc n
Doc ([Node Pos] -> [Doc (Node Pos)])
-> Either (Pos, String) [Node Pos]
-> Either (Pos, String) [Doc (Node Pos)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (Either (Pos, String) [Node Pos])
-> Either (Pos, String) [Node Pos]
forall a. Identity a -> a
runIdentity (Loader Identity (Node Pos)
-> ByteString -> Identity (Either (Pos, String) [Node Pos])
forall n (m :: * -> *).
MonadFix m =>
Loader m n -> ByteString -> m (Either (Pos, String) [n])
decodeLoader Loader Identity (Node Pos)
failsafeLoader ByteString
bs0)
  where
    failsafeLoader :: Loader Identity (Node Pos)
failsafeLoader = Loader :: forall (m :: * -> *) n.
(Tag -> ScalarStyle -> Text -> LoaderT m n)
-> (Tag -> [n] -> LoaderT m n)
-> (Tag -> [(n, n)] -> LoaderT m n)
-> (NodeId -> Bool -> n -> LoaderT m n)
-> (NodeId -> n -> LoaderT m n)
-> Loader m n
Loader { yScalar :: Tag -> ScalarStyle -> Text -> LoaderT Identity (Node Pos)
yScalar   = \Tag
t ScalarStyle
s Text
v Pos
pos-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ case Tag -> ScalarStyle -> Text -> Either String Scalar
schemaResolverScalar Tag
t ScalarStyle
s Text
v of
                                                                Left  String
e  -> (Pos, String) -> Either (Pos, String) (Node Pos)
forall a b. a -> Either a b
Left (Pos
pos,String
e)
                                                                Right Scalar
v' -> Node Pos -> Either (Pos, String) (Node Pos)
forall a b. b -> Either a b
Right (Pos -> Scalar -> Node Pos
forall loc. loc -> Scalar -> Node loc
Scalar Pos
pos Scalar
v')
                            , ySequence :: Tag -> [Node Pos] -> LoaderT Identity (Node Pos)
ySequence = \Tag
t [Node Pos]
vs Pos
pos -> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ case Tag -> Either String Tag
schemaResolverSequence Tag
t of
                                                                Left  String
e  -> (Pos, String) -> Either (Pos, String) (Node Pos)
forall a b. a -> Either a b
Left (Pos
pos,String
e)
                                                                Right Tag
t' -> Node Pos -> Either (Pos, String) (Node Pos)
forall a b. b -> Either a b
Right (Pos -> Tag -> [Node Pos] -> Node Pos
forall loc. loc -> Tag -> [Node loc] -> Node loc
Sequence Pos
pos Tag
t' [Node Pos]
vs)
                            , yMapping :: Tag -> [(Node Pos, Node Pos)] -> LoaderT Identity (Node Pos)
yMapping  = \Tag
t [(Node Pos, Node Pos)]
kvs Pos
pos-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ case Tag -> Either String Tag
schemaResolverMapping  Tag
t of
                                                                Left  String
e  -> (Pos, String) -> Either (Pos, String) (Node Pos)
forall a b. a -> Either a b
Left (Pos
pos,String
e)
                                                                Right Tag
t' -> Pos -> Tag -> Mapping Pos -> Node Pos
forall loc. loc -> Tag -> Mapping loc -> Node loc
Mapping Pos
pos Tag
t' (Mapping Pos -> Node Pos)
-> Either (Pos, String) (Mapping Pos)
-> Either (Pos, String) (Node Pos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Node Pos, Node Pos)] -> Either (Pos, String) (Mapping Pos)
mkMap [(Node Pos, Node Pos)]
kvs
                            , yAlias :: NodeId -> Bool -> Node Pos -> LoaderT Identity (Node Pos)
yAlias    = if Bool
allowCycles
                                          then \NodeId
_ Bool
_ Node Pos
n Pos
_-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ Node Pos -> Either (Pos, String) (Node Pos)
forall a b. b -> Either a b
Right Node Pos
n
                                          else \NodeId
_ Bool
c Node Pos
n Pos
pos -> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ if Bool
c then (Pos, String) -> Either (Pos, String) (Node Pos)
forall a b. a -> Either a b
Left (Pos
pos,String
"cycle detected") else Node Pos -> Either (Pos, String) (Node Pos)
forall a b. b -> Either a b
Right Node Pos
n
                            , yAnchor :: NodeId -> Node Pos -> LoaderT Identity (Node Pos)
yAnchor   = if Bool
anchorNodes
                                          then \NodeId
j Node Pos
n Pos
pos  -> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ Node Pos -> Either (Pos, String) (Node Pos)
forall a b. b -> Either a b
Right (Pos -> NodeId -> Node Pos -> Node Pos
forall loc. loc -> NodeId -> Node loc -> Node loc
Anchor Pos
pos NodeId
j Node Pos
n)
                                          else \NodeId
_ Node Pos
n Pos
_  -> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Pos, String) (Node Pos)
 -> Identity (Either (Pos, String) (Node Pos)))
-> Either (Pos, String) (Node Pos)
-> Identity (Either (Pos, String) (Node Pos))
forall a b. (a -> b) -> a -> b
$ Node Pos -> Either (Pos, String) (Node Pos)
forall a b. b -> Either a b
Right Node Pos
n
                            }

    mkMap :: [(Node Pos, Node Pos)] -> Either (Pos, String) (Map (Node Pos) (Node Pos))
    mkMap :: [(Node Pos, Node Pos)] -> Either (Pos, String) (Mapping Pos)
mkMap [(Node Pos, Node Pos)]
kvs
      | Bool
schemaResolverMappingDuplicates = Mapping Pos -> Either (Pos, String) (Mapping Pos)
forall a b. b -> Either a b
Right (Mapping Pos -> Either (Pos, String) (Mapping Pos))
-> Mapping Pos -> Either (Pos, String) (Mapping Pos)
forall a b. (a -> b) -> a -> b
$! [(Node Pos, Node Pos)] -> Mapping Pos
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Node Pos, Node Pos)]
kvs
      | Bool
otherwise = case [(Node Pos, Node Pos)] -> Either (Node Pos, Node Pos) (Mapping Pos)
forall k a. Ord k => [(k, a)] -> Either (k, a) (Map k a)
mapFromListNoDupes [(Node Pos, Node Pos)]
kvs of
          Left (Node Pos
k,Node Pos
_) -> (Pos, String) -> Either (Pos, String) (Mapping Pos)
forall a b. a -> Either a b
Left (Node Pos -> Pos
forall loc. Node loc -> loc
nodeLoc Node Pos
k,String
"Duplicate key in mapping: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Node Pos -> String
forall a. Show a => a -> String
show Node Pos
k)
          Right Mapping Pos
m    -> Mapping Pos -> Either (Pos, String) (Mapping Pos)
forall a b. b -> Either a b
Right Mapping Pos
m

----------------------------------------------------------------------------

-- | YAML Parser 'Monad' used by 'FromYAML'
--
-- See also 'parseEither' or 'decode'
newtype Parser a = P { Parser a -> Either (Pos, String) a
unP :: Either (Pos, String) a }

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (P Either (Pos, String) a
x) = Either (Pos, String) b -> Parser b
forall a. Either (Pos, String) a -> Parser a
P ((a -> b) -> Either (Pos, String) a -> Either (Pos, String) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either (Pos, String) a
x)

  a
x <$ :: a -> Parser b -> Parser a
<$ P (Right b
_) = Either (Pos, String) a -> Parser a
forall a. Either (Pos, String) a -> Parser a
P (a -> Either (Pos, String) a
forall a b. b -> Either a b
Right a
x)
  a
_ <$ P (Left (Pos, String)
e)  = Either (Pos, String) a -> Parser a
forall a. Either (Pos, String) a -> Parser a
P ((Pos, String) -> Either (Pos, String) a
forall a b. a -> Either a b
Left (Pos, String)
e)

instance Applicative Parser where
  pure :: a -> Parser a
pure = Either (Pos, String) a -> Parser a
forall a. Either (Pos, String) a -> Parser a
P (Either (Pos, String) a -> Parser a)
-> (a -> Either (Pos, String) a) -> a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Pos, String) a
forall a b. b -> Either a b
Right

  P (Left (Pos, String)
e)  <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
_   = Either (Pos, String) b -> Parser b
forall a. Either (Pos, String) a -> Parser a
P ((Pos, String) -> Either (Pos, String) b
forall a b. a -> Either a b
Left (Pos, String)
e)
  P (Right a -> b
f) <*> P Either (Pos, String) a
r = Either (Pos, String) b -> Parser b
forall a. Either (Pos, String) a -> Parser a
P ((a -> b) -> Either (Pos, String) a -> Either (Pos, String) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either (Pos, String) a
r)

  P (Left (Pos, String)
e)   *> :: Parser a -> Parser b -> Parser b
*> Parser b
_   = Either (Pos, String) b -> Parser b
forall a. Either (Pos, String) a -> Parser a
P ((Pos, String) -> Either (Pos, String) b
forall a b. a -> Either a b
Left (Pos, String)
e)
  P (Right a
_)  *> Parser b
p   = Parser b
p

instance Monad Parser where
  return :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  P Either (Pos, String) a
m >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
k = Either (Pos, String) b -> Parser b
forall a. Either (Pos, String) a -> Parser a
P (Either (Pos, String) a
m Either (Pos, String) a
-> (a -> Either (Pos, String) b) -> Either (Pos, String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser b -> Either (Pos, String) b
forall a. Parser a -> Either (Pos, String) a
unP (Parser b -> Either (Pos, String) b)
-> (a -> Parser b) -> a -> Either (Pos, String) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser b
k)
  >> :: Parser a -> Parser b -> Parser b
(>>) = Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
#if !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
#endif


-- | @since 0.1.1.0
--
-- __NOTE__: 'fail' doesn't convey proper position information unless used within the @with*@-style helpers; consequently it's recommended to use 'failAtNode' when /not/ covered by the location scope of a @with*@-style combinator.
instance Fail.MonadFail Parser where
  fail :: String -> Parser a
fail String
s = Either (Pos, String) a -> Parser a
forall a. Either (Pos, String) a -> Parser a
P ((Pos, String) -> Either (Pos, String) a
forall a b. a -> Either a b
Left (Pos
fakePos, String
s))

-- | Trigger parsing failure located at a specific 'Node'
--
-- @since 0.2.0.0
failAtNode :: Node Pos -> String -> Parser a
failAtNode :: Node Pos -> String -> Parser a
failAtNode Node Pos
n String
s = Either (Pos, String) a -> Parser a
forall a. Either (Pos, String) a -> Parser a
P ((Pos, String) -> Either (Pos, String) a
forall a b. a -> Either a b
Left (Node Pos -> Pos
forall loc. Node loc -> loc
nodeLoc Node Pos
n, String
s))

-- | @since 0.1.1.0
instance Alternative Parser where
  empty :: Parser a
empty = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"

  P (Left (Pos, String)
_) <|> :: Parser a -> Parser a -> Parser a
<|> Parser a
y = Parser a
y
  Parser a
x          <|> Parser a
_ = Parser a
x

-- | @since 0.1.1.0
instance MonadPlus Parser where
  mzero :: Parser a
mzero = Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: Parser a -> Parser a -> Parser a
mplus = Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- | Run 'Parser'
--
-- A common use-case is 'parseEither' 'parseYAML'.
parseEither :: Parser a -> Either (Pos, String) a
parseEither :: Parser a -> Either (Pos, String) a
parseEither = Parser a -> Either (Pos, String) a
forall a. Parser a -> Either (Pos, String) a
unP

-- | Informative failure helper
--
-- This is typically used in fall-through cases of 'parseYAML' like so
--
-- > instance FromYAML ... where
-- >   parseYAML ...  = ...
-- >   parseYAML node = typeMismatch "SomeThing" node
--
-- @since 0.1.1.0
typeMismatch :: String   -- ^ descriptive name of expected data
             -> Node Pos     -- ^ actual node
             -> Parser a
typeMismatch :: String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
node = Node Pos -> String -> Parser a
forall a. Node Pos -> String -> Parser a
failAtNode Node Pos
node (String
"expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" instead of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
got)
  where
    got :: String
got = case Node Pos
node of
            Scalar Pos
_ (SBool Bool
_)             -> String
"!!bool"
            Scalar Pos
_ (SInt Integer
_)              -> String
"!!int"
            Scalar Pos
_  Scalar
SNull                -> String
"!!null"
            Scalar Pos
_ (SStr Text
_)              -> String
"!!str"
            Scalar Pos
_ (SFloat Double
_)            -> String
"!!float"
            Scalar Pos
_ (SUnknown Tag
t Text
v)
              | Tag -> Bool
isUntagged Tag
t               -> Tag -> String
tagged Tag
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
v
              | Bool
otherwise                  -> String
"(unsupported) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tag -> String
tagged Tag
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"scalar"
            Anchor Pos
_ NodeId
_ Node Pos
_                   -> String
"anchor"
            Mapping Pos
_ Tag
t Mapping Pos
_                  -> Tag -> String
tagged Tag
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" mapping"
            Sequence Pos
_ Tag
t [Node Pos]
_                 -> Tag -> String
tagged Tag
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" sequence"

    tagged :: Tag -> String
tagged Tag
t0 = case Tag -> Maybe Text
tagToText Tag
t0 of
               Maybe Text
Nothing -> String
"non-specifically ? tagged (i.e. unresolved) "
               Just Text
t  -> Text -> String
T.unpack Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tagged"

-- | A type into which YAML nodes can be converted/deserialized
class FromYAML a where
  parseYAML :: Node Pos -> Parser a

-- This helper fixes up 'fakePos' locations to a better guess; this is
-- mostly used by the with*-style combinators
{-# INLINE fixupFailPos #-}
fixupFailPos :: Pos -> Parser a -> Parser a
fixupFailPos :: Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (P (Left (Pos
pos0,String
emsg)))
  | Pos
pos0 Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
fakePos  = Either (Pos, String) a -> Parser a
forall a. Either (Pos, String) a -> Parser a
P ((Pos, String) -> Either (Pos, String) a
forall a b. a -> Either a b
Left (Pos
pos,String
emsg))
fixupFailPos Pos
_ Parser a
p = Parser a
p

-- | Operate on @tag:yaml.org,2002:null@ node (or fail)
withNull :: String -> Parser a -> Node Pos -> Parser a
withNull :: String -> Parser a -> Node Pos -> Parser a
withNull String
_        Parser a
f (Scalar Pos
pos Scalar
SNull) = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos Parser a
f
withNull String
expected Parser a
_ Node Pos
v                  = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

-- | Operate on t'Scalar' node (or fail)
--
-- @since 0.2.1
withScalar :: String -> (Scalar -> Parser a) -> Node Pos -> Parser a
withScalar :: String -> (Scalar -> Parser a) -> Node Pos -> Parser a
withScalar String
_        Scalar -> Parser a
f (Scalar Pos
pos Scalar
sca) = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (Scalar -> Parser a
f Scalar
sca)
withScalar String
expected Scalar -> Parser a
_ Node Pos
v                = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

-- | Trivial instance
instance (loc ~ Pos) => FromYAML (Node loc) where
  parseYAML :: Node Pos -> Parser (Node loc)
parseYAML = Node Pos -> Parser (Node loc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | @since 0.2.1
instance FromYAML Scalar where
  parseYAML :: Node Pos -> Parser Scalar
parseYAML = String -> (Scalar -> Parser Scalar) -> Node Pos -> Parser Scalar
forall a. String -> (Scalar -> Parser a) -> Node Pos -> Parser a
withScalar String
"scalar" Scalar -> Parser Scalar
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromYAML Bool where
  parseYAML :: Node Pos -> Parser Bool
parseYAML = String -> (Bool -> Parser Bool) -> Node Pos -> Parser Bool
forall a. String -> (Bool -> Parser a) -> Node Pos -> Parser a
withBool String
"!!bool" Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Operate on @tag:yaml.org,2002:bool@ node (or fail)
withBool :: String -> (Bool -> Parser a) -> Node Pos -> Parser a
withBool :: String -> (Bool -> Parser a) -> Node Pos -> Parser a
withBool String
_        Bool -> Parser a
f (Scalar Pos
pos (SBool Bool
b)) = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (Bool -> Parser a
f Bool
b)
withBool String
expected Bool -> Parser a
_ Node Pos
v                      = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

instance FromYAML Text where
  parseYAML :: Node Pos -> Parser Text
parseYAML = String -> (Text -> Parser Text) -> Node Pos -> Parser Text
forall a. String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
"!!str" Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Operate on @tag:yaml.org,2002:str@ node (or fail)
withStr :: String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr :: String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
_        Text -> Parser a
f (Scalar Pos
pos (SStr Text
b)) = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (Text -> Parser a
f Text
b)
withStr String
expected Text -> Parser a
_ Node Pos
v                     = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

instance FromYAML Integer where
  parseYAML :: Node Pos -> Parser Integer
parseYAML = String -> (Integer -> Parser Integer) -> Node Pos -> Parser Integer
forall a. String -> (Integer -> Parser a) -> Node Pos -> Parser a
withInt String
"!!int" Integer -> Parser Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Operate on @tag:yaml.org,2002:int@ node (or fail)
withInt :: String -> (Integer -> Parser a) -> Node Pos -> Parser a
withInt :: String -> (Integer -> Parser a) -> Node Pos -> Parser a
withInt String
_        Integer -> Parser a
f (Scalar Pos
pos (SInt Integer
b)) = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (Integer -> Parser a
f Integer
b)
withInt String
expected Integer -> Parser a
_ Node Pos
v                     = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

-- | @since 0.1.1.0
instance FromYAML Natural where
  parseYAML :: Node Pos -> Parser Natural
parseYAML = String -> (Integer -> Parser Natural) -> Node Pos -> Parser Natural
forall a. String -> (Integer -> Parser a) -> Node Pos -> Parser a
withInt String
"!!int" ((Integer -> Parser Natural) -> Node Pos -> Parser Natural)
-> (Integer -> Parser Natural) -> Node Pos -> Parser Natural
forall a b. (a -> b) -> a -> b
$ \Integer
b -> if Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then String -> Parser Natural
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"!!int " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of range for 'Natural'")
                                               else Natural -> Parser Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
b)

-- helper for fixed-width integers
{-# INLINE parseInt #-}
parseInt :: (Integral a, Bounded a) => [Char] -> Node Pos -> Parser a
parseInt :: String -> Node Pos -> Parser a
parseInt String
name = String -> (Integer -> Parser a) -> Node Pos -> Parser a
forall a. String -> (Integer -> Parser a) -> Node Pos -> Parser a
withInt String
"!!int" ((Integer -> Parser a) -> Node Pos -> Parser a)
-> (Integer -> Parser a) -> Node Pos -> Parser a
forall a b. (a -> b) -> a -> b
$ \Integer
b -> Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"!!int " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of range for '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Parser a) -> Maybe a -> Parser a
forall a b. (a -> b) -> a -> b
$
                                        Integer -> Maybe a
forall n. (Integral n, Bounded n) => Integer -> Maybe n
fromIntegerMaybe Integer
b

instance FromYAML Int    where parseYAML :: Node Pos -> Parser Int
parseYAML = String -> Node Pos -> Parser Int
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Int"
instance FromYAML Int8   where parseYAML :: Node Pos -> Parser Int8
parseYAML = String -> Node Pos -> Parser Int8
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Int8"
instance FromYAML Int16  where parseYAML :: Node Pos -> Parser Int16
parseYAML = String -> Node Pos -> Parser Int16
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Int16"
instance FromYAML Int32  where parseYAML :: Node Pos -> Parser Int32
parseYAML = String -> Node Pos -> Parser Int32
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Int32"
instance FromYAML Int64  where parseYAML :: Node Pos -> Parser Int64
parseYAML = String -> Node Pos -> Parser Int64
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Int64"
instance FromYAML Word   where parseYAML :: Node Pos -> Parser NodeId
parseYAML = String -> Node Pos -> Parser NodeId
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Word"
instance FromYAML Word8  where parseYAML :: Node Pos -> Parser Word8
parseYAML = String -> Node Pos -> Parser Word8
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Word8"
instance FromYAML Word16 where parseYAML :: Node Pos -> Parser Word16
parseYAML = String -> Node Pos -> Parser Word16
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Word16"
instance FromYAML Word32 where parseYAML :: Node Pos -> Parser Word32
parseYAML = String -> Node Pos -> Parser Word32
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Word32"
instance FromYAML Word64 where parseYAML :: Node Pos -> Parser Word64
parseYAML = String -> Node Pos -> Parser Word64
forall a. (Integral a, Bounded a) => String -> Node Pos -> Parser a
parseInt String
"Word64"


instance FromYAML Double where
  parseYAML :: Node Pos -> Parser Double
parseYAML = String -> (Double -> Parser Double) -> Node Pos -> Parser Double
forall a. String -> (Double -> Parser a) -> Node Pos -> Parser a
withFloat String
"!!float" Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Operate on @tag:yaml.org,2002:float@ node (or fail)
withFloat :: String -> (Double -> Parser a) -> Node Pos -> Parser a
withFloat :: String -> (Double -> Parser a) -> Node Pos -> Parser a
withFloat String
_        Double -> Parser a
f (Scalar Pos
pos (SFloat Double
b)) = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (Double -> Parser a
f Double
b)
withFloat String
expected Double -> Parser a
_ Node Pos
v                       = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v


instance (Ord k, FromYAML k, FromYAML v) => FromYAML (Map k v) where
  parseYAML :: Node Pos -> Parser (Map k v)
parseYAML = String
-> (Mapping Pos -> Parser (Map k v))
-> Node Pos
-> Parser (Map k v)
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"!!map" ((Mapping Pos -> Parser (Map k v)) -> Node Pos -> Parser (Map k v))
-> (Mapping Pos -> Parser (Map k v))
-> Node Pos
-> Parser (Map k v)
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
xs -> [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Parser [(k, v)] -> Parser (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node Pos, Node Pos) -> Parser (k, v))
-> [(Node Pos, Node Pos)] -> Parser [(k, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Node Pos
a,Node Pos
b) -> (,) (k -> v -> (k, v)) -> Parser k -> Parser (v -> (k, v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser k
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a Parser (v -> (k, v)) -> Parser v -> Parser (k, v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser v
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b) (Mapping Pos -> [(Node Pos, Node Pos)]
forall k a. Map k a -> [(k, a)]
Map.toList Mapping Pos
xs)

-- | Operate on @tag:yaml.org,2002:map@ node (or fail)
withMap :: String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap :: String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
_        Mapping Pos -> Parser a
f (Mapping Pos
pos Tag
tag Mapping Pos
xs)
  | Tag
tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagMap    = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos (Mapping Pos -> Parser a
f Mapping Pos
xs)
withMap String
expected Mapping Pos -> Parser a
_ Node Pos
v = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

instance FromYAML v => FromYAML [v] where
  parseYAML :: Node Pos -> Parser [v]
parseYAML = String -> ([Node Pos] -> Parser [v]) -> Node Pos -> Parser [v]
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" ((Node Pos -> Parser v) -> [Node Pos] -> Parser [v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node Pos -> Parser v
forall a. FromYAML a => Node Pos -> Parser a
parseYAML)

-- | Operate on @tag:yaml.org,2002:seq@ node (or fail)
withSeq :: String -> ([Node Pos] -> Parser a) -> Node Pos-> Parser a
withSeq :: String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
_        [Node Pos] -> Parser a
f (Sequence Pos
pos Tag
tag [Node Pos]
xs)
  | Tag
tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagSeq    = Pos -> Parser a -> Parser a
forall a. Pos -> Parser a -> Parser a
fixupFailPos Pos
pos ([Node Pos] -> Parser a
f [Node Pos]
xs)
withSeq String
expected [Node Pos] -> Parser a
_ Node Pos
v = String -> Node Pos -> Parser a
forall a. String -> Node Pos -> Parser a
typeMismatch String
expected Node Pos
v

instance FromYAML a => FromYAML (Maybe a) where
  parseYAML :: Node Pos -> Parser (Maybe a)
parseYAML (Scalar Pos
_ Scalar
SNull) = Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseYAML Node Pos
j                = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
j

----------------------------------------------------------------------------

instance (FromYAML a, FromYAML b) => FromYAML (a,b) where
  parseYAML :: Node Pos -> Parser (a, b)
parseYAML = String
-> ([Node Pos] -> Parser (a, b)) -> Node Pos -> Parser (a, b)
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" (([Node Pos] -> Parser (a, b)) -> Node Pos -> Parser (a, b))
-> ([Node Pos] -> Parser (a, b)) -> Node Pos -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \[Node Pos]
xs ->
                           case [Node Pos]
xs of
                             [Node Pos
a,Node Pos
b] -> (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a
                                          Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser b
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b
                             [Node Pos]
_     -> String -> Parser (a, b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected 2-sequence but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Node Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node Pos]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sequence instead")

instance (FromYAML a, FromYAML b, FromYAML c) => FromYAML (a,b,c) where
  parseYAML :: Node Pos -> Parser (a, b, c)
parseYAML = String
-> ([Node Pos] -> Parser (a, b, c)) -> Node Pos -> Parser (a, b, c)
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" (([Node Pos] -> Parser (a, b, c)) -> Node Pos -> Parser (a, b, c))
-> ([Node Pos] -> Parser (a, b, c)) -> Node Pos -> Parser (a, b, c)
forall a b. (a -> b) -> a -> b
$ \[Node Pos]
xs ->
                           case [Node Pos]
xs of
                             [Node Pos
a,Node Pos
b,Node Pos
c] -> (,,) (a -> b -> c -> (a, b, c))
-> Parser a -> Parser (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a
                                             Parser (b -> c -> (a, b, c)) -> Parser b -> Parser (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser b
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b
                                             Parser (c -> (a, b, c)) -> Parser c -> Parser (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser c
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
c
                             [Node Pos]
_     -> String -> Parser (a, b, c)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected 3-sequence but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Node Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node Pos]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sequence instead")


instance (FromYAML a, FromYAML b, FromYAML c, FromYAML d) => FromYAML (a,b,c,d) where
  parseYAML :: Node Pos -> Parser (a, b, c, d)
parseYAML = String
-> ([Node Pos] -> Parser (a, b, c, d))
-> Node Pos
-> Parser (a, b, c, d)
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" (([Node Pos] -> Parser (a, b, c, d))
 -> Node Pos -> Parser (a, b, c, d))
-> ([Node Pos] -> Parser (a, b, c, d))
-> Node Pos
-> Parser (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \[Node Pos]
xs ->
                           case [Node Pos]
xs of
                             [Node Pos
a,Node Pos
b,Node Pos
c,Node Pos
d] -> (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Parser a -> Parser (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a
                                                Parser (b -> c -> d -> (a, b, c, d))
-> Parser b -> Parser (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser b
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b
                                                Parser (c -> d -> (a, b, c, d))
-> Parser c -> Parser (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser c
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
c
                                                Parser (d -> (a, b, c, d)) -> Parser d -> Parser (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser d
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
d
                             [Node Pos]
_     -> String -> Parser (a, b, c, d)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected 4-sequence but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Node Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node Pos]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sequence instead")


instance (FromYAML a, FromYAML b, FromYAML c, FromYAML d, FromYAML e) => FromYAML (a,b,c,d,e) where
  parseYAML :: Node Pos -> Parser (a, b, c, d, e)
parseYAML = String
-> ([Node Pos] -> Parser (a, b, c, d, e))
-> Node Pos
-> Parser (a, b, c, d, e)
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" (([Node Pos] -> Parser (a, b, c, d, e))
 -> Node Pos -> Parser (a, b, c, d, e))
-> ([Node Pos] -> Parser (a, b, c, d, e))
-> Node Pos
-> Parser (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ \[Node Pos]
xs ->
                           case [Node Pos]
xs of
                             [Node Pos
a,Node Pos
b,Node Pos
c,Node Pos
d,Node Pos
e] -> (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Parser a -> Parser (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a
                                                   Parser (b -> c -> d -> e -> (a, b, c, d, e))
-> Parser b -> Parser (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser b
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b
                                                   Parser (c -> d -> e -> (a, b, c, d, e))
-> Parser c -> Parser (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser c
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
c
                                                   Parser (d -> e -> (a, b, c, d, e))
-> Parser d -> Parser (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser d
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
d
                                                   Parser (e -> (a, b, c, d, e)) -> Parser e -> Parser (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser e
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
e
                             [Node Pos]
_     -> String -> Parser (a, b, c, d, e)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected 5-sequence but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Node Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node Pos]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sequence instead")


instance (FromYAML a, FromYAML b, FromYAML c, FromYAML d, FromYAML e, FromYAML f) => FromYAML (a,b,c,d,e,f) where
  parseYAML :: Node Pos -> Parser (a, b, c, d, e, f)
parseYAML = String
-> ([Node Pos] -> Parser (a, b, c, d, e, f))
-> Node Pos
-> Parser (a, b, c, d, e, f)
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" (([Node Pos] -> Parser (a, b, c, d, e, f))
 -> Node Pos -> Parser (a, b, c, d, e, f))
-> ([Node Pos] -> Parser (a, b, c, d, e, f))
-> Node Pos
-> Parser (a, b, c, d, e, f)
forall a b. (a -> b) -> a -> b
$ \[Node Pos]
xs ->
                           case [Node Pos]
xs of
                             [Node Pos
a,Node Pos
b,Node Pos
c,Node Pos
d,Node Pos
e,Node Pos
f] -> (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Parser a -> Parser (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a
                                                      Parser (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Parser b -> Parser (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser b
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b
                                                      Parser (c -> d -> e -> f -> (a, b, c, d, e, f))
-> Parser c -> Parser (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser c
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
c
                                                      Parser (d -> e -> f -> (a, b, c, d, e, f))
-> Parser d -> Parser (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser d
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
d
                                                      Parser (e -> f -> (a, b, c, d, e, f))
-> Parser e -> Parser (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser e
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
e
                                                      Parser (f -> (a, b, c, d, e, f))
-> Parser f -> Parser (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser f
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
f
                             [Node Pos]
_     -> String -> Parser (a, b, c, d, e, f)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected 6-sequence but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Node Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node Pos]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sequence instead")


instance (FromYAML a, FromYAML b, FromYAML c, FromYAML d, FromYAML e, FromYAML f, FromYAML g) => FromYAML (a,b,c,d,e,f,g) where
  parseYAML :: Node Pos -> Parser (a, b, c, d, e, f, g)
parseYAML = String
-> ([Node Pos] -> Parser (a, b, c, d, e, f, g))
-> Node Pos
-> Parser (a, b, c, d, e, f, g)
forall a.
String -> ([Node Pos] -> Parser a) -> Node Pos -> Parser a
withSeq String
"!!seq" (([Node Pos] -> Parser (a, b, c, d, e, f, g))
 -> Node Pos -> Parser (a, b, c, d, e, f, g))
-> ([Node Pos] -> Parser (a, b, c, d, e, f, g))
-> Node Pos
-> Parser (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \[Node Pos]
xs ->
                           case [Node Pos]
xs of
                             [Node Pos
a,Node Pos
b,Node Pos
c,Node Pos
d,Node Pos
e,Node Pos
f,Node Pos
g] -> (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Parser a
-> Parser (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node Pos -> Parser a
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
a
                                                         Parser (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Parser b
-> Parser (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser b
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
b
                                                         Parser (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Parser c -> Parser (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser c
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
c
                                                         Parser (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Parser d -> Parser (e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser d
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
d
                                                         Parser (e -> f -> g -> (a, b, c, d, e, f, g))
-> Parser e -> Parser (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser e
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
e
                                                         Parser (f -> g -> (a, b, c, d, e, f, g))
-> Parser f -> Parser (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser f
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
f
                                                         Parser (g -> (a, b, c, d, e, f, g))
-> Parser g -> Parser (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node Pos -> Parser g
forall a. FromYAML a => Node Pos -> Parser a
parseYAML Node Pos
g
                             [Node Pos]
_     -> String -> Parser (a, b, c, d, e, f, g)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected 7-sequence but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Node Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Node Pos]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-sequence instead")


-- | Decode YAML document(s) using the YAML 1.2 Core schema
--
-- Each document contained in the YAML stream produce one element of
-- the response list. Here's an example of decoding two concatenated
-- YAML documents:
--
-- >>> decode "Foo\n---\nBar" :: Either (Pos,String) [Text]
-- Right ["Foo","Bar"]
--
-- Note that an empty stream doesn't contain any (non-comment)
-- document nodes, and therefore results in an empty result list:
--
-- >>> decode "# just a comment" :: Either (Pos,String) [Text]
-- Right []
--
-- 'decode' uses the same settings as 'decodeNode' for tag-resolving. If
-- you need a different custom parsing configuration, you need to
-- combine 'parseEither' and `decodeNode'` yourself.
--
-- The 'decode' as well as the 'decodeNode' functions supports
-- decoding from YAML streams using the UTF-8, UTF-16 (LE or BE), or
-- UTF-32 (LE or BE) encoding (which is auto-detected).
--
-- @since 0.2.0
--
decode :: FromYAML v => BS.L.ByteString -> Either (Pos, String) [v]
decode :: ByteString -> Either (Pos, String) [v]
decode ByteString
bs0 = ByteString -> Either (Pos, String) [Doc (Node Pos)]
decodeNode ByteString
bs0 Either (Pos, String) [Doc (Node Pos)]
-> ([Doc (Node Pos)] -> Either (Pos, String) [v])
-> Either (Pos, String) [v]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Doc (Node Pos) -> Either (Pos, String) v)
-> [Doc (Node Pos)] -> Either (Pos, String) [v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser v -> Either (Pos, String) v
forall a. Parser a -> Either (Pos, String) a
parseEither (Parser v -> Either (Pos, String) v)
-> (Doc (Node Pos) -> Parser v)
-> Doc (Node Pos)
-> Either (Pos, String) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Pos -> Parser v
forall a. FromYAML a => Node Pos -> Parser a
parseYAML (Node Pos -> Parser v)
-> (Doc (Node Pos) -> Node Pos) -> Doc (Node Pos) -> Parser v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Doc Node Pos
x) -> Node Pos
x))

-- | Convenience wrapper over 'decode' expecting exactly one YAML document
--
-- >>> decode1 "---\nBar\n..." :: Either (Pos,String) Text
-- Right "Bar"
--
-- >>> decode1 "Foo\n---\nBar" :: Either (Pos,String) Text
-- Left (Pos {posByteOffset = 8, posCharOffset = 8, posLine = 3, posColumn = 0},"unexpected multiple YAML documents")
--
-- >>> decode1 "# Just a comment" :: Either (Pos,String) Text
-- Left (Pos {posByteOffset = 0, posCharOffset = 0, posLine = 1, posColumn = 0},"empty YAML stream")
--
-- @since 0.2.0
--
decode1 :: FromYAML v => BS.L.ByteString -> Either (Pos, String) v
decode1 :: ByteString -> Either (Pos, String) v
decode1 ByteString
bs0 = do
  [Doc (Node Pos)]
docs <- ByteString -> Either (Pos, String) [Doc (Node Pos)]
decodeNode ByteString
bs0
  case [Doc (Node Pos)]
docs of
    []  -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Pos :: Int -> Int -> Int -> Int -> Pos
Pos { posByteOffset :: Int
posByteOffset = Int
0, posCharOffset :: Int
posCharOffset = Int
0, posLine :: Int
posLine = Int
1, posColumn :: Int
posColumn = Int
0 }, String
"empty YAML stream")
    [Doc Node Pos
v] -> Parser v -> Either (Pos, String) v
forall a. Parser a -> Either (Pos, String) a
parseEither (Parser v -> Either (Pos, String) v)
-> Parser v -> Either (Pos, String) v
forall a b. (a -> b) -> a -> b
$ Node Pos -> Parser v
forall a. FromYAML a => Node Pos -> Parser a
parseYAML (Node Pos -> Parser v) -> Node Pos -> Parser v
forall a b. (a -> b) -> a -> b
$ Node Pos
v
    (Doc (Node Pos)
_:Doc Node Pos
n:[Doc (Node Pos)]
_) -> (Pos, String) -> Either (Pos, String) v
forall a b. a -> Either a b
Left (Node Pos -> Pos
forall loc. Node loc -> loc
nodeLoc Node Pos
n, String
"unexpected multiple YAML documents")

-- | Like 'decode' but takes a strict 'BS.ByteString'
--
-- @since 0.2.0
--
decodeStrict :: FromYAML v => BS.ByteString -> Either (Pos, String) [v]
decodeStrict :: ByteString -> Either (Pos, String) [v]
decodeStrict = ByteString -> Either (Pos, String) [v]
forall v. FromYAML v => ByteString -> Either (Pos, String) [v]
decode (ByteString -> Either (Pos, String) [v])
-> (ByteString -> ByteString)
-> ByteString
-> Either (Pos, String) [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])

-- | Like 'decode1' but takes a strict 'BS.ByteString'
--
-- @since 0.2.0
--
decode1Strict :: FromYAML v => BS.ByteString -> Either (Pos, String) v
decode1Strict :: ByteString -> Either (Pos, String) v
decode1Strict = ByteString -> Either (Pos, String) v
forall v. FromYAML v => ByteString -> Either (Pos, String) v
decode1 (ByteString -> Either (Pos, String) v)
-> (ByteString -> ByteString)
-> ByteString
-> Either (Pos, String) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])

-- $dumping
--
-- We address the process of dumping information from a Haskell-data type(s) to a YAML document(s) as encoding.
--
-- Suppose we want to 'encode' a Haskell-data type Person
--
-- @
-- data Person = Person
--     { name :: Text
--     , age  :: Int
--     } deriving Show
-- @
--
-- To 'encode' data, we need to define a 'ToYAML' instance.
--
-- @
--
-- instance 'ToYAML' Person where
--     \-- this generates a 'Node'
--     'toYAML' (Person n a) = 'mapping' [ "name" .= n, "age" .= a]
--
-- @
--
-- We can now 'encode' a node like so:
--
-- >>> encode [Person {name = "Vijay", age = 19}]
-- "age: 19\nname: Vijay\n"
--
-- There are predefined 'ToYAML' instances for many types. Here's an example encoding a complex Haskell Node'
--
-- >>> encode1 $ toYAML ([1,2,3], Map.fromList [(1, 2)])
-- "- - 1\n  - 2\n  - 3\n- 1: 2\n"
--


-- | A type from which YAML nodes can be constructed
--
-- @since 0.2.0.0
class ToYAML a where
  -- | Convert a Haskell Data-type to a YAML Node data type.
  toYAML :: a -> Node ()

instance Loc loc => ToYAML (Node loc) where
  toYAML :: Node loc -> Node ()
toYAML = Node loc -> Node ()
forall loc (f :: * -> *). (Loc loc, Functor f) => f loc -> f ()
toUnit

instance ToYAML Bool where
  toYAML :: Bool -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Bool -> Scalar) -> Bool -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Scalar
SBool

instance ToYAML Double where
  toYAML :: Double -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Double -> Scalar) -> Double -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scalar
SFloat

instance ToYAML Int     where toYAML :: Int -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Int -> Scalar) -> Int -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Int -> Integer) -> Int -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Int8    where toYAML :: Int8 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Int8 -> Scalar) -> Int8 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Int8 -> Integer) -> Int8 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Int16   where toYAML :: Int16 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Int16 -> Scalar) -> Int16 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Int16 -> Integer) -> Int16 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Int32   where toYAML :: Int32 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Int32 -> Scalar) -> Int32 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Int32 -> Integer) -> Int32 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Int64   where toYAML :: Int64 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Int64 -> Scalar) -> Int64 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Int64 -> Integer) -> Int64 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Word    where toYAML :: NodeId -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (NodeId -> Scalar) -> NodeId -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (NodeId -> Integer) -> NodeId -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeId -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Word8   where toYAML :: Word8 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Word8 -> Scalar) -> Word8 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Word8 -> Integer) -> Word8 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Word16  where toYAML :: Word16 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Word16 -> Scalar) -> Word16 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Word16 -> Integer) -> Word16 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Word32  where toYAML :: Word32 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Word32 -> Scalar) -> Word32 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Word32 -> Integer) -> Word32 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Word64  where toYAML :: Word64 -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Word64 -> Scalar) -> Word64 -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Word64 -> Integer) -> Word64 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Natural where toYAML :: Natural -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Natural -> Scalar) -> Natural -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt (Integer -> Scalar) -> (Natural -> Integer) -> Natural -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
instance ToYAML Integer where toYAML :: Integer -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Integer -> Scalar) -> Integer -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt


instance ToYAML Text where
  toYAML :: Text -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () (Scalar -> Node ()) -> (Text -> Scalar) -> Text -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Scalar
SStr

-- | @since 0.2.1
instance ToYAML Scalar where
  toYAML :: Scalar -> Node ()
toYAML = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar ()

instance ToYAML a => ToYAML (Maybe a) where
  toYAML :: Maybe a -> Node ()
toYAML Maybe a
Nothing  = () -> Scalar -> Node ()
forall loc. loc -> Scalar -> Node loc
Scalar () Scalar
SNull
  toYAML (Just a
a) = a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a

-- instance (ToYAML a, ToYAML b) => ToYAML (Either a b) where
--     toYAML (Left a)  = toYAML a
--     toYAML (Right b) = toYAML b

instance ToYAML a => ToYAML [a] where
  toYAML :: [a] -> Node ()
toYAML = () -> Tag -> [Node ()] -> Node ()
forall loc. loc -> Tag -> [Node loc] -> Node loc
Sequence () Tag
tagSeq ([Node ()] -> Node ()) -> ([a] -> [Node ()]) -> [a] -> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Node ()) -> [a] -> [Node ()]
forall a b. (a -> b) -> [a] -> [b]
map a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML

instance (Ord k, ToYAML k, ToYAML v) => ToYAML (Map k v) where
  toYAML :: Map k v -> Node ()
toYAML Map k v
kv = () -> Tag -> Mapping () -> Node ()
forall loc. loc -> Tag -> Mapping loc -> Node loc
Mapping () Tag
tagMap ([(Node (), Node ())] -> Mapping ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Node (), Node ())] -> Mapping ())
-> [(Node (), Node ())] -> Mapping ()
forall a b. (a -> b) -> a -> b
$ ((k, v) -> (Node (), Node ())) -> [(k, v)] -> [(Node (), Node ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k,v
v) -> (k -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML k
k , v -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML v
v)) (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
kv))

instance (ToYAML a, ToYAML b) => ToYAML (a, b) where
  toYAML :: (a, b) -> Node ()
toYAML (a
a,b
b) = [Node ()] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML [a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a, b -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML b
b]

instance (ToYAML a, ToYAML b, ToYAML c) => ToYAML (a, b, c) where
  toYAML :: (a, b, c) -> Node ()
toYAML (a
a,b
b,c
c) = [Node ()] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML [a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a, b -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML b
b, c -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML c
c]

instance (ToYAML a, ToYAML b, ToYAML c, ToYAML d) => ToYAML (a, b, c, d) where
  toYAML :: (a, b, c, d) -> Node ()
toYAML (a
a,b
b,c
c,d
d) = [Node ()] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML [a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a, b -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML b
b, c -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML c
c, d -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML d
d]

instance (ToYAML a, ToYAML b, ToYAML c, ToYAML d, ToYAML e) => ToYAML (a, b, c, d, e) where
  toYAML :: (a, b, c, d, e) -> Node ()
toYAML (a
a,b
b,c
c,d
d,e
e) = [Node ()] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML [a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a, b -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML b
b, c -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML c
c, d -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML d
d, e -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML e
e]

instance (ToYAML a, ToYAML b, ToYAML c, ToYAML d, ToYAML e, ToYAML f) => ToYAML (a, b, c, d, e, f) where
  toYAML :: (a, b, c, d, e, f) -> Node ()
toYAML (a
a,b
b,c
c,d
d,e
e,f
f) = [Node ()] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML [a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a, b -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML b
b, c -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML c
c, d -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML d
d, e -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML e
e, f -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML f
f]

instance (ToYAML a, ToYAML b, ToYAML c, ToYAML d, ToYAML e, ToYAML f, ToYAML g) => ToYAML (a, b, c, d, e, f, g) where
  toYAML :: (a, b, c, d, e, f, g) -> Node ()
toYAML (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = [Node ()] -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML [a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
a, b -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML b
b, c -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML c
c, d -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML d
d, e -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML e
e, f -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML f
f, g -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML g
g]


-- | Serialize YAML Node(s) using the YAML 1.2 Core schema to a lazy 'Data.YAML.Token.UTF8' encoded 'BS.L.ByteString'.
--
-- Each YAML Node produces exactly one YAML Document.
--
-- Here is an example of encoding a list of strings to produce a list of YAML Documents
--
-- >>> encode (["Document 1", "Document 2"] :: [Text])
-- "Document 1\n...\nDocument 2\n"
--
-- If we treat the above list of strings as a single sequence then we will produce a single YAML Document having a single sequence.
--
-- >>> encode ([["Document 1", "Document 2"]] :: [[Text]])
-- "- Document 1\n- Document 2\n"
--
-- Alternatively, if you only need a single YAML document in a YAML stream you might want to use the convenience function 'encode1'; or, if you need more control over the encoding, see 'encodeNode''.
--
-- @since 0.2.0
encode :: ToYAML v => [v] -> BS.L.ByteString
encode :: [v] -> ByteString
encode [v]
vList = [Doc (Node ())] -> ByteString
encodeNode ([Doc (Node ())] -> ByteString) -> [Doc (Node ())] -> ByteString
forall a b. (a -> b) -> a -> b
$ (v -> Doc (Node ())) -> [v] -> [Doc (Node ())]
forall a b. (a -> b) -> [a] -> [b]
map (Node () -> Doc (Node ())
forall n. n -> Doc n
Doc (Node () -> Doc (Node ())) -> (v -> Node ()) -> v -> Doc (Node ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML) [v]
vList

-- | Convenience wrapper over 'encode' taking exactly one YAML Node.
-- Hence it will always output exactly one YAML Document
--
-- Here is example of encoding a list of strings to produce exactly one of YAML Documents
--
-- >>> encode1 (["Document 1", "Document 2"] :: [Text])
-- "- Document 1\n- Document 2\n"
--
-- @since 0.2.0
encode1 :: ToYAML v => v -> BS.L.ByteString
encode1 :: v -> ByteString
encode1 v
a = [v] -> ByteString
forall v. ToYAML v => [v] -> ByteString
encode [v
a]

-- | Like 'encode' but outputs 'BS.ByteString'
--
-- @since 0.2.0
encodeStrict :: ToYAML v => [v] -> BS.ByteString
encodeStrict :: [v] -> ByteString
encodeStrict = ByteString -> ByteString
bsToStrict (ByteString -> ByteString)
-> ([v] -> ByteString) -> [v] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ByteString
forall v. ToYAML v => [v] -> ByteString
encode

-- | Like 'encode1' but outputs a strict 'BS.ByteString'
--
-- @since 0.2.0
encode1Strict :: ToYAML v => v -> BS.ByteString
encode1Strict :: v -> ByteString
encode1Strict = ByteString -> ByteString
bsToStrict (ByteString -> ByteString) -> (v -> ByteString) -> v -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall v. ToYAML v => v -> ByteString
encode1

-- Internal helper
class Loc loc where
  toUnit :: Functor f => f loc -> f ()
  toUnit = (() () -> f loc -> f ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)

instance Loc Pos

instance Loc () where toUnit :: f () -> f ()
toUnit = f () -> f ()
forall a. a -> a
id

-- | Represents a key-value pair in YAML t'Mapping's
--
-- See also '.=' and 'mapping'
--
-- @since 0.2.1
type Pair = (Node (), Node ())

-- | @since 0.2.0
(.=) :: ToYAML a => Text -> a -> Pair
Text
name .= :: Text -> a -> (Node (), Node ())
.= a
node = (Text -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML Text
name, a -> Node ()
forall a. ToYAML a => a -> Node ()
toYAML a
node)

-- | @since 0.2.0
mapping :: [Pair] -> Node ()
mapping :: [(Node (), Node ())] -> Node ()
mapping = () -> Tag -> Mapping () -> Node ()
forall loc. loc -> Tag -> Mapping loc -> Node loc
Mapping () Tag
tagMap (Mapping () -> Node ())
-> ([(Node (), Node ())] -> Mapping ())
-> [(Node (), Node ())]
-> Node ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Node (), Node ())] -> Mapping ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList