{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe          #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
module Data.YAML.Internal
    ( Node(..)
    , nodeLoc
    , NodeId
    , Doc(..)
    , Mapping
    ) where

import qualified Data.Map                  as Map

import           Data.YAML.Event           (Tag)
import           Data.YAML.Loader          (NodeId)
import           Data.YAML.Schema.Internal (Scalar (..))

import           Util

-- | YAML Document tree/graph
--
-- __NOTE__: In future versions of this API meta-data about the YAML document might be included as additional fields inside 'Doc'
newtype Doc n = Doc
   { forall n. Doc n -> n
docRoot :: n -- ^ @since 0.2.1
   } deriving (Doc n -> Doc n -> Bool
(Doc n -> Doc n -> Bool) -> (Doc n -> Doc n -> Bool) -> Eq (Doc n)
forall n. Eq n => Doc n -> Doc n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall n. Eq n => Doc n -> Doc n -> Bool
== :: Doc n -> Doc n -> Bool
$c/= :: forall n. Eq n => Doc n -> Doc n -> Bool
/= :: Doc n -> Doc n -> Bool
Eq,Eq (Doc n)
Eq (Doc n) =>
(Doc n -> Doc n -> Ordering)
-> (Doc n -> Doc n -> Bool)
-> (Doc n -> Doc n -> Bool)
-> (Doc n -> Doc n -> Bool)
-> (Doc n -> Doc n -> Bool)
-> (Doc n -> Doc n -> Doc n)
-> (Doc n -> Doc n -> Doc n)
-> Ord (Doc n)
Doc n -> Doc n -> Bool
Doc n -> Doc n -> Ordering
Doc n -> Doc n -> Doc n
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 n. Ord n => Eq (Doc n)
forall n. Ord n => Doc n -> Doc n -> Bool
forall n. Ord n => Doc n -> Doc n -> Ordering
forall n. Ord n => Doc n -> Doc n -> Doc n
$ccompare :: forall n. Ord n => Doc n -> Doc n -> Ordering
compare :: Doc n -> Doc n -> Ordering
$c< :: forall n. Ord n => Doc n -> Doc n -> Bool
< :: Doc n -> Doc n -> Bool
$c<= :: forall n. Ord n => Doc n -> Doc n -> Bool
<= :: Doc n -> Doc n -> Bool
$c> :: forall n. Ord n => Doc n -> Doc n -> Bool
> :: Doc n -> Doc n -> Bool
$c>= :: forall n. Ord n => Doc n -> Doc n -> Bool
>= :: Doc n -> Doc n -> Bool
$cmax :: forall n. Ord n => Doc n -> Doc n -> Doc n
max :: Doc n -> Doc n -> Doc n
$cmin :: forall n. Ord n => Doc n -> Doc n -> Doc n
min :: Doc n -> Doc n -> Doc n
Ord,Int -> Doc n -> ShowS
[Doc n] -> ShowS
Doc n -> String
(Int -> Doc n -> ShowS)
-> (Doc n -> String) -> ([Doc n] -> ShowS) -> Show (Doc n)
forall n. Show n => Int -> Doc n -> ShowS
forall n. Show n => [Doc n] -> ShowS
forall n. Show n => Doc n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> Doc n -> ShowS
showsPrec :: Int -> Doc n -> ShowS
$cshow :: forall n. Show n => Doc n -> String
show :: Doc n -> String
$cshowList :: forall n. Show n => [Doc n] -> ShowS
showList :: [Doc n] -> ShowS
Show,(forall x. Doc n -> Rep (Doc n) x)
-> (forall x. Rep (Doc n) x -> Doc n) -> Generic (Doc n)
forall x. Rep (Doc n) x -> Doc n
forall x. Doc n -> Rep (Doc n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (Doc n) x -> Doc n
forall n x. Doc n -> Rep (Doc n) x
$cfrom :: forall n x. Doc n -> Rep (Doc n) x
from :: forall x. Doc n -> Rep (Doc n) x
$cto :: forall n x. Rep (Doc n) x -> Doc n
to :: forall x. Rep (Doc n) x -> Doc n
Generic)

-- | @since 0.2.0
instance NFData n => NFData (Doc n) where
  rnf :: Doc n -> ()
rnf (Doc n
n) = n -> ()
forall a. NFData a => a -> ()
rnf n
n

-- | @since 0.2.1
instance Functor Doc where
  fmap :: forall a b. (a -> b) -> Doc a -> Doc b
fmap a -> b
f (Doc a
n) = b -> Doc b
forall n. n -> Doc n
Doc (a -> b
f a
n)
  a
x <$ :: forall a b. a -> Doc b -> Doc a
<$ Doc b
_ = a -> Doc a
forall n. n -> Doc n
Doc a
x

-- | YAML mapping
type Mapping loc = Map (Node loc) (Node loc)

-- | YAML Document node
--
-- @since 0.2.0
data Node loc
  = Scalar   !loc !Scalar
  | Mapping  !loc !Tag (Mapping loc)
  | Sequence !loc !Tag [Node loc]
  | Anchor   !loc !NodeId !(Node loc)
  deriving (Int -> Node loc -> ShowS
[Node loc] -> ShowS
Node loc -> String
(Int -> Node loc -> ShowS)
-> (Node loc -> String) -> ([Node loc] -> ShowS) -> Show (Node loc)
forall loc. Show loc => Int -> Node loc -> ShowS
forall loc. Show loc => [Node loc] -> ShowS
forall loc. Show loc => Node loc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall loc. Show loc => Int -> Node loc -> ShowS
showsPrec :: Int -> Node loc -> ShowS
$cshow :: forall loc. Show loc => Node loc -> String
show :: Node loc -> String
$cshowList :: forall loc. Show loc => [Node loc] -> ShowS
showList :: [Node loc] -> ShowS
Show,(forall x. Node loc -> Rep (Node loc) x)
-> (forall x. Rep (Node loc) x -> Node loc) -> Generic (Node loc)
forall x. Rep (Node loc) x -> Node loc
forall x. Node loc -> Rep (Node loc) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc x. Rep (Node loc) x -> Node loc
forall loc x. Node loc -> Rep (Node loc) x
$cfrom :: forall loc x. Node loc -> Rep (Node loc) x
from :: forall x. Node loc -> Rep (Node loc) x
$cto :: forall loc x. Rep (Node loc) x -> Node loc
to :: forall x. Rep (Node loc) x -> Node loc
Generic)

nodeLoc :: Node loc -> loc
nodeLoc :: forall loc. Node loc -> loc
nodeLoc (Scalar loc
pos Scalar
_)     = loc
pos
nodeLoc (Anchor loc
pos NodeId
_ Node loc
_)   = loc
pos
nodeLoc (Mapping loc
pos Tag
_ Mapping loc
_)  = loc
pos
nodeLoc (Sequence loc
pos Tag
_ [Node loc]
_) = loc
pos

instance Functor Node where
  fmap :: forall a b. (a -> b) -> Node a -> Node b
fmap a -> b
f Node a
node = case Node a
node of
    Scalar   a
x Scalar
scalar -> b -> Scalar -> Node b
forall loc. loc -> Scalar -> Node loc
Scalar   (a -> b
f a
x) Scalar
scalar
    Mapping  a
x Tag
tag Mapping a
m  -> b -> Tag -> Mapping b -> Node b
forall loc. loc -> Tag -> Mapping loc -> Node loc
Mapping  (a -> b
f a
x) Tag
tag ((a -> b) -> Mapping a -> Mapping b
forall a b. (a -> b) -> Mapping a -> Mapping b
mappingFmapLoc a -> b
f Mapping a
m)
    Sequence a
x Tag
tag [Node a]
s  -> b -> Tag -> [Node b] -> Node b
forall loc. loc -> Tag -> [Node loc] -> Node loc
Sequence (a -> b
f a
x) Tag
tag ((Node a -> Node b) -> [Node a] -> [Node b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Node a]
s)
    Anchor   a
x NodeId
n Node a
nod  -> b -> NodeId -> Node b -> Node b
forall loc. loc -> NodeId -> Node loc -> Node loc
Anchor   (a -> b
f a
x) NodeId
n ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Node a
nod)

mappingFmapLoc :: (a -> b) -> Mapping a -> Mapping b
mappingFmapLoc :: forall a b. (a -> b) -> Mapping a -> Mapping b
mappingFmapLoc a -> b
f = (Node a -> Node b)
-> Map (Node a) (Node b) -> Map (Node b) (Node b)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Map (Node a) (Node b) -> Map (Node b) (Node b))
-> (Mapping a -> Map (Node a) (Node b))
-> Mapping a
-> Map (Node b) (Node b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node a -> Node b) -> Mapping a -> Map (Node a) (Node b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

instance Eq (Node loc) where
  Scalar   loc
_ Scalar
a    == :: Node loc -> Node loc -> Bool
==  Scalar   loc
_ Scalar
a'    = Scalar
a Scalar -> Scalar -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar
a'
  Mapping  loc
_ Tag
a Mapping loc
b  ==  Mapping  loc
_ Tag
a' Mapping loc
b' = Tag
a Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
a' Bool -> Bool -> Bool
&& Mapping loc
b Mapping loc -> Mapping loc -> Bool
forall a. Eq a => a -> a -> Bool
== Mapping loc
b'
  Sequence loc
_ Tag
a [Node loc]
b  ==  Sequence loc
_ Tag
a' [Node loc]
b' = Tag
a Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
a' Bool -> Bool -> Bool
&& [Node loc]
b [Node loc] -> [Node loc] -> Bool
forall a. Eq a => a -> a -> Bool
== [Node loc]
b'
  Anchor   loc
_ NodeId
a Node loc
b  ==  Anchor   loc
_ NodeId
a' Node loc
b' = NodeId
a NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
a' Bool -> Bool -> Bool
&& Node loc
b Node loc -> Node loc -> Bool
forall a. Eq a => a -> a -> Bool
== Node loc
b'
  Node loc
_ == Node loc
_ = Bool
False

instance Ord (Node loc) where
  compare :: Node loc -> Node loc -> Ordering
compare (Scalar loc
_ Scalar
a)      (Scalar loc
_ Scalar
a')      = Scalar -> Scalar -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Scalar
a Scalar
a'
  compare (Scalar loc
_ Scalar
_)      (Mapping loc
_ Tag
_ Mapping loc
_)    = Ordering
LT
  compare (Scalar loc
_ Scalar
_)      (Sequence loc
_ Tag
_ [Node loc]
_)   = Ordering
LT
  compare (Scalar loc
_ Scalar
_)      (Anchor loc
_ NodeId
_ Node loc
_)     = Ordering
LT

  compare (Mapping loc
_ Tag
_ Mapping loc
_)   (Scalar loc
_ Scalar
_)       = Ordering
GT
  compare (Mapping loc
_ Tag
a Mapping loc
b)   (Mapping loc
_ Tag
a' Mapping loc
b')  = (Tag, Mapping loc) -> (Tag, Mapping loc) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tag
a,Mapping loc
b) (Tag
a',Mapping loc
b')
  compare (Mapping loc
_ Tag
_ Mapping loc
_)   (Sequence loc
_ Tag
_ [Node loc]
_)   = Ordering
LT
  compare (Mapping loc
_ Tag
_ Mapping loc
_)   (Anchor loc
_ NodeId
_ Node loc
_)     = Ordering
LT

  compare (Sequence loc
_ Tag
_ [Node loc]
_)  (Scalar loc
_ Scalar
_)       = Ordering
GT
  compare (Sequence loc
_ Tag
_ [Node loc]
_)  (Mapping loc
_ Tag
_ Mapping loc
_)    = Ordering
GT
  compare (Sequence loc
_ Tag
a [Node loc]
b)  (Sequence loc
_ Tag
a' [Node loc]
b') = (Tag, [Node loc]) -> (Tag, [Node loc]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tag
a,[Node loc]
b) (Tag
a',[Node loc]
b')
  compare (Sequence loc
_ Tag
_ [Node loc]
_)  (Anchor loc
_ NodeId
_ Node loc
_)     = Ordering
LT

  compare (Anchor loc
_ NodeId
_ Node loc
_)    (Scalar loc
_ Scalar
_)       = Ordering
GT
  compare (Anchor loc
_ NodeId
_ Node loc
_)    (Mapping loc
_ Tag
_ Mapping loc
_)    = Ordering
GT
  compare (Anchor loc
_ NodeId
_ Node loc
_)    (Sequence loc
_ Tag
_ [Node loc]
_)   = Ordering
GT
  compare (Anchor loc
_ NodeId
a Node loc
b)    (Anchor loc
_ NodeId
a' Node loc
b')   = (NodeId, Node loc) -> (NodeId, Node loc) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NodeId
a,Node loc
b) (NodeId
a',Node loc
b')