Libyaml.hs

module CfnFlip.Libyaml
  ( InvalidYamlEvent (..)
  , makeMapping
  , makeSequence
  , startsMapOrSequence
  , isSameStart
  , isStartsEnd
  , takeMapOrSequenceC
  , module Text.Libyaml
  ) where

import CfnFlip.Prelude

import CfnFlip.Conduit
import Text.Libyaml
  ( Event (..)
  , MappingStyle (..)
  , SequenceStyle (..)
  , Style (..)
  , Tag (..)
  )

data InvalidYamlEvent = InvalidYamlEvent Event String
  deriving stock (Show)
  deriving anyclass (Exception)

makeMapping
  :: Monad m => ByteString -> ConduitT i Event m () -> ConduitT i Event m ()
makeMapping tag inner = do
  yield $ EventMappingStart NoTag BlockMapping Nothing
  yield $ EventScalar tag NoTag Plain Nothing
  inner
  yield EventMappingEnd

makeSequence :: Monad m => ConduitT i Event m () -> ConduitT i Event m ()
makeSequence inner = do
  yield $ EventSequenceStart NoTag BlockSequence Nothing
  inner
  yield EventSequenceEnd

startsMapOrSequence :: Event -> Bool
startsMapOrSequence = \case
  EventMappingStart {} -> True
  EventSequenceStart {} -> True
  _ -> False

isSameStart :: Event -> Event -> Bool
x `isSameStart` y = case (x, y) of
  (EventMappingStart {}, EventMappingStart {}) -> True
  (EventSequenceStart {}, EventSequenceStart {}) -> True
  _ -> False

isStartsEnd :: Event -> Event -> Bool
x `isStartsEnd` y = case (x, y) of
  (EventMappingStart {}, EventMappingEnd {}) -> True
  (EventSequenceStart {}, EventSequenceEnd {}) -> True
  _ -> False

takeMapOrSequenceC :: Monad m => Event -> ConduitT Event Event m ()
takeMapOrSequenceC e = takeBalancedC (isSameStart e) (isStartsEnd e)