{-# 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
   { 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
/= :: Doc n -> Doc n -> Bool
$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
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
min :: Doc n -> Doc n -> Doc n
$cmin :: forall n. Ord n => Doc n -> Doc n -> Doc n
max :: Doc n -> Doc n -> Doc n
$cmax :: forall n. Ord n => Doc n -> Doc n -> Doc n
>= :: 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
$c< :: forall n. Ord n => Doc n -> Doc n -> Bool
compare :: Doc n -> Doc n -> Ordering
$ccompare :: forall n. Ord n => Doc n -> Doc n -> Ordering
$cp1Ord :: forall n. Ord n => Eq (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
showList :: [Doc n] -> ShowS
$cshowList :: forall n. Show n => [Doc n] -> ShowS
show :: Doc n -> String
$cshow :: forall n. Show n => Doc n -> String
showsPrec :: Int -> Doc n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> 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
$cto :: forall n x. Rep (Doc n) x -> Doc n
$cfrom :: forall n x. Doc n -> Rep (Doc n) x
Generic)

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

-- | @since 0.2.1
instance Functor Doc where
  fmap :: (a -> b) -> Doc a -> Doc b
fmap f :: a -> b
f (Doc n :: a
n) = b -> Doc b
forall n. n -> Doc n
Doc (a -> b
f a
n)
  x :: a
x <$ :: a -> Doc b -> Doc a
<$ _ = 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
showList :: [Node loc] -> ShowS
$cshowList :: forall loc. Show loc => [Node loc] -> ShowS
show :: Node loc -> String
$cshow :: forall loc. Show loc => Node loc -> String
showsPrec :: Int -> Node loc -> ShowS
$cshowsPrec :: forall loc. Show loc => Int -> 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
$cto :: forall loc x. Rep (Node loc) x -> Node loc
$cfrom :: forall loc x. Node loc -> Rep (Node loc) x
Generic)

nodeLoc :: Node loc -> loc
nodeLoc :: Node loc -> loc
nodeLoc (Scalar pos :: loc
pos _)     = loc
pos
nodeLoc (Anchor pos :: loc
pos _ _)   = loc
pos
nodeLoc (Mapping pos :: loc
pos _ _)  = loc
pos
nodeLoc (Sequence pos :: loc
pos _ _) = loc
pos

instance Functor Node where
  fmap :: (a -> b) -> Node a -> Node b
fmap f :: a -> b
f node :: Node a
node = case Node a
node of
    Scalar   x :: a
x scalar :: Scalar
scalar -> b -> Scalar -> Node b
forall loc. loc -> Scalar -> Node loc
Scalar   (a -> b
f a
x) Scalar
scalar
    Mapping  x :: a
x tag :: Tag
tag m :: 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 x :: a
x tag :: Tag
tag s :: [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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Node a]
s)
    Anchor   x :: a
x n :: NodeId
n nod :: 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 (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 :: (a -> b) -> Mapping a -> Mapping b
mappingFmapLoc f :: a -> b
f = (Node a -> Node b) -> Map (Node a) (Node b) -> Mapping b
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic ((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) -> Mapping b)
-> (Mapping a -> Map (Node a) (Node b)) -> Mapping a -> Mapping 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

instance Eq (Node loc) where
  Scalar   _ a :: Scalar
a    == :: Node loc -> Node loc -> Bool
==  Scalar   _ a' :: Scalar
a'    = Scalar
a Scalar -> Scalar -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar
a'
  Mapping  _ a :: Tag
a b :: Mapping loc
b  ==  Mapping  _ a' :: Tag
a' b' :: 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 _ a :: Tag
a b :: [Node loc]
b  ==  Sequence _ a' :: Tag
a' b' :: [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   _ a :: NodeId
a b :: Node loc
b  ==  Anchor   _ a' :: NodeId
a' b' :: 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'
  _ == _ = Bool
False

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

  compare (Mapping _ _ _)   (Scalar _ _)       = Ordering
GT
  compare (Mapping _ a :: Tag
a b :: Mapping loc
b)   (Mapping _ a' :: Tag
a' b' :: 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 _ _ _)   (Sequence _ _ _)   = Ordering
LT
  compare (Mapping _ _ _)   (Anchor _ _ _)     = Ordering
LT

  compare (Sequence _ _ _)  (Scalar _ _)       = Ordering
GT
  compare (Sequence _ _ _)  (Mapping _ _ _)    = Ordering
GT
  compare (Sequence _ a :: Tag
a b :: [Node loc]
b)  (Sequence _ a' :: Tag
a' b' :: [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 _ _ _)  (Anchor _ _ _)     = Ordering
LT

  compare (Anchor _ _ _)    (Scalar _ _)       = Ordering
GT
  compare (Anchor _ _ _)    (Mapping _ _ _)    = Ordering
GT
  compare (Anchor _ _ _)    (Sequence _ _ _)   = Ordering
GT
  compare (Anchor _ a :: NodeId
a b :: Node loc
b)    (Anchor _ a' :: NodeId
a' b' :: 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')