{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Binary.Cuddle (
  CuddleData,
  huddleDecoderEquivalenceSpec,
  specWithHuddle,
  huddleRoundTripCborSpec,
  huddleRoundTripAnnCborSpec,
  writeSpec,
) where

import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR,
  EncCBOR,
  Version,
  decodeFullDecoder,
  toPlainEncoding,
 )
import Cardano.Ledger.Binary.Decoding (label)
import qualified Codec.CBOR.Cuddle.CBOR.Gen as Cuddle
import qualified Codec.CBOR.Cuddle.CDDL as Cuddle
import qualified Codec.CBOR.Cuddle.CDDL.CTree as Cuddle
import qualified Codec.CBOR.Cuddle.CDDL.Resolve as Cuddle
import qualified Codec.CBOR.Cuddle.Huddle as Cuddle
import Codec.CBOR.Cuddle.Pretty ()
import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Pretty as CBOR
import qualified Codec.CBOR.Term as CBOR
import qualified Codec.CBOR.Write as CBOR
import Data.Data (Proxy (..))
import Data.Foldable (traverse_)
import Data.Functor.Identity (Identity)
import Data.List (unfoldr)
import qualified Data.Text as T
import GHC.Stack (HasCallStack)
import Prettyprinter (Pretty (pretty))
import Prettyprinter.Render.Text (hPutDoc)
import System.IO (IOMode (..), hPutStrLn, withFile)
import Test.Cardano.Ledger.Binary (decoderEquivalenceExpectation)
import Test.Cardano.Ledger.Binary.Annotator (decodeFullAnnotator)
import Test.Cardano.Ledger.Binary.RoundTrip (
  RoundTripFailure (RoundTripFailure),
  Trip (..),
  cborTrip,
  decodeAnnExtra,
  embedTripLabelExtra,
 )
import Test.Hspec (
  Expectation,
  Spec,
  SpecWith,
  beforeAll,
  expectationFailure,
  it,
  shouldBe,
 )
import Test.Hspec.Core.Spec (Example (..), paramsQuickCheckArgs)
import Test.QuickCheck (Args (replay))
import Test.QuickCheck.Random (QCGen, mkQCGen)

data CuddleData = CuddleData
  { CuddleData -> CTreeRoot' Identity MonoRef
cddl :: !(Cuddle.CTreeRoot' Identity Cuddle.MonoRef)
  , CuddleData -> Int
numExamples :: !Int
  }

newtype Seeded a = Seeded
  { forall a. Seeded a -> QCGen -> a
runSeeded :: QCGen -> a
  }

instance Example (a -> Seeded Expectation) where
  type Arg (a -> Seeded Expectation) = a
  evaluateExample :: (a -> Seeded Expectation)
-> Params
-> (ActionWith (Arg (a -> Seeded Expectation)) -> Expectation)
-> ProgressCallback
-> IO Result
evaluateExample a -> Seeded Expectation
e Params
params ActionWith (Arg (a -> Seeded Expectation)) -> Expectation
hook =
    let qcGen :: QCGen
qcGen = QCGen -> ((QCGen, Int) -> QCGen) -> Maybe (QCGen, Int) -> QCGen
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> QCGen
mkQCGen Int
0) (QCGen, Int) -> QCGen
forall a b. (a, b) -> a
fst (Args -> Maybe (QCGen, Int)
replay (Args -> Maybe (QCGen, Int)) -> Args -> Maybe (QCGen, Int)
forall a b. (a -> b) -> a -> b
$ Params -> Args
paramsQuickCheckArgs Params
params)
        example :: a -> Expectation
example a
a = Seeded Expectation -> QCGen -> Expectation
forall a. Seeded a -> QCGen -> a
runSeeded (a -> Seeded Expectation
e a
a) QCGen
qcGen
     in (a -> Expectation)
-> Params
-> (ActionWith (Arg (a -> Expectation)) -> Expectation)
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> Expectation)
-> ProgressCallback
-> IO Result
evaluateExample a -> Expectation
example Params
params ActionWith (Arg (a -> Expectation)) -> Expectation
ActionWith (Arg (a -> Seeded Expectation)) -> Expectation
hook

huddleDecoderEquivalenceSpec ::
  forall a.
  (HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
  -- | Serialization version
  Version ->
  -- | Name of the CDDL rule to test
  T.Text ->
  SpecWith CuddleData
huddleDecoderEquivalenceSpec :: forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleDecoderEquivalenceSpec Version
version Text
ruleName =
  let lbl :: Text
lbl = Proxy a -> Text
forall a. DecCBOR a => Proxy a -> Text
label (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
   in String
-> (CuddleData -> Seeded Expectation)
-> SpecWith (Arg (CuddleData -> Seeded Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (Text -> String
T.unpack Text
ruleName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
lbl) ((CuddleData -> Seeded Expectation)
 -> SpecWith (Arg (CuddleData -> Seeded Expectation)))
-> (CuddleData -> Seeded Expectation)
-> SpecWith (Arg (CuddleData -> Seeded Expectation))
forall a b. (a -> b) -> a -> b
$
        \CuddleData
cddlData ->
          CuddleData -> Name -> (Term -> Expectation) -> Seeded Expectation
withGenTerm CuddleData
cddlData (Text -> Name
Cuddle.Name Text
ruleName) ((Term -> Expectation) -> Seeded Expectation)
-> (Term -> Expectation) -> Seeded Expectation
forall a b. (a -> b) -> a -> b
$ \Term
term -> do
            let encoding :: Encoding
encoding = Term -> Encoding
CBOR.encodeTerm Term
term
                initCborBytes :: ByteString
initCborBytes = Encoding -> ByteString
CBOR.toLazyByteString Encoding
encoding
            forall t.
(Eq t, DecCBOR t, DecCBOR (Annotator t), Show t) =>
Version -> ByteString -> Expectation
decoderEquivalenceExpectation @a Version
version ByteString
initCborBytes

huddleRoundTripCborSpec ::
  forall a.
  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
  -- | Serialization version
  Version ->
  -- | Name of the CDDL rule to test
  T.Text ->
  SpecWith CuddleData
huddleRoundTripCborSpec :: forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec Version
version Text
ruleName =
  let lbl :: Text
lbl = Proxy a -> Text
forall a. DecCBOR a => Proxy a -> Text
label (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
      trip :: Trip a a
trip = forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @a
   in String
-> (CuddleData -> Seeded Expectation)
-> SpecWith (Arg (CuddleData -> Seeded Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (Text -> String
T.unpack Text
ruleName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
lbl) ((CuddleData -> Seeded Expectation)
 -> SpecWith (Arg (CuddleData -> Seeded Expectation)))
-> (CuddleData -> Seeded Expectation)
-> SpecWith (Arg (CuddleData -> Seeded Expectation))
forall a b. (a -> b) -> a -> b
$
        \CuddleData
cddlData ->
          CuddleData -> Name -> (Term -> Expectation) -> Seeded Expectation
withGenTerm CuddleData
cddlData (Text -> Name
Cuddle.Name Text
ruleName) ((Term -> Expectation) -> Seeded Expectation)
-> (Term -> Expectation) -> Seeded Expectation
forall a b. (a -> b) -> a -> b
$
            Text -> Version -> Version -> Trip a a -> Term -> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
Text -> Version -> Version -> Trip a a -> Term -> Expectation
roundTripExample Text
lbl Version
version Version
version Trip a a
trip

huddleRoundTripAnnCborSpec ::
  forall a.
  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
  -- | Serialization version
  Version ->
  -- | Name of the CDDL rule to test
  T.Text ->
  SpecWith CuddleData
huddleRoundTripAnnCborSpec :: forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripAnnCborSpec Version
version Text
ruleName =
  let lbl :: Text
lbl = Proxy (Annotator a) -> Text
forall a. DecCBOR a => Proxy a -> Text
label (Proxy (Annotator a) -> Text) -> Proxy (Annotator a) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator a)
      trip :: Trip a (Annotator a)
trip = forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @a
   in String
-> (CuddleData -> Seeded Expectation)
-> SpecWith (Arg (CuddleData -> Seeded Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (Text -> String
T.unpack Text
ruleName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
lbl) ((CuddleData -> Seeded Expectation)
 -> SpecWith (Arg (CuddleData -> Seeded Expectation)))
-> (CuddleData -> Seeded Expectation)
-> SpecWith (Arg (CuddleData -> Seeded Expectation))
forall a b. (a -> b) -> a -> b
$
        \CuddleData
cddlData ->
          CuddleData -> Name -> (Term -> Expectation) -> Seeded Expectation
withGenTerm CuddleData
cddlData (Text -> Name
Cuddle.Name Text
ruleName) ((Term -> Expectation) -> Seeded Expectation)
-> (Term -> Expectation) -> Seeded Expectation
forall a b. (a -> b) -> a -> b
$
            Text
-> Version
-> Version
-> Trip a (Annotator a)
-> Term
-> Expectation
forall a.
(HasCallStack, Show a, Eq a) =>
Text
-> Version
-> Version
-> Trip a (Annotator a)
-> Term
-> Expectation
roundTripAnnExample Text
lbl Version
version Version
version Trip a (Annotator a)
trip

specWithHuddle :: Cuddle.Huddle -> Int -> SpecWith CuddleData -> Spec
specWithHuddle :: Huddle -> Int -> SpecWith CuddleData -> Spec
specWithHuddle Huddle
h Int
numExamples =
  IO CuddleData -> SpecWith CuddleData -> Spec
forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll (IO CuddleData -> SpecWith CuddleData -> Spec)
-> IO CuddleData -> SpecWith CuddleData -> Spec
forall a b. (a -> b) -> a -> b
$
    let cddl :: CDDL
cddl = Huddle -> CDDL
Cuddle.toCDDL Huddle
h
        rCddl :: Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
rCddl = CDDL -> Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
Cuddle.fullResolveCDDL CDDL
cddl
     in case Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
rCddl of
          Right CTreeRoot' Identity MonoRef
ct ->
            CuddleData -> IO CuddleData
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CuddleData -> IO CuddleData) -> CuddleData -> IO CuddleData
forall a b. (a -> b) -> a -> b
$
              CuddleData
                { cddl :: CTreeRoot' Identity MonoRef
cddl = CTreeRoot' Identity MonoRef
ct
                , numExamples :: Int
numExamples = Int
numExamples
                }
          Left NameResolutionFailure
nrf -> String -> IO CuddleData
forall a. HasCallStack => String -> a
error (String -> IO CuddleData) -> String -> IO CuddleData
forall a b. (a -> b) -> a -> b
$ NameResolutionFailure -> String
forall a. Show a => a -> String
show NameResolutionFailure
nrf

withGenTerm :: CuddleData -> Cuddle.Name -> (CBOR.Term -> Expectation) -> Seeded Expectation
withGenTerm :: CuddleData -> Name -> (Term -> Expectation) -> Seeded Expectation
withGenTerm CuddleData
cd Name
n Term -> Expectation
withTerm = (QCGen -> Expectation) -> Seeded Expectation
forall a. (QCGen -> a) -> Seeded a
Seeded ((QCGen -> Expectation) -> Seeded Expectation)
-> (QCGen -> Expectation) -> Seeded Expectation
forall a b. (a -> b) -> a -> b
$ \QCGen
gen ->
  let terms :: [Term]
terms =
        Int -> [Term] -> [Term]
forall a. Int -> [a] -> [a]
take (CuddleData -> Int
numExamples CuddleData
cd) ([Term] -> [Term]) -> [Term] -> [Term]
forall a b. (a -> b) -> a -> b
$
          (QCGen -> Maybe (Term, QCGen)) -> QCGen -> [Term]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((Term, QCGen) -> Maybe (Term, QCGen)
forall a. a -> Maybe a
Just ((Term, QCGen) -> Maybe (Term, QCGen))
-> (QCGen -> (Term, QCGen)) -> QCGen -> Maybe (Term, QCGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTreeRoot' Identity MonoRef -> Name -> QCGen -> (Term, QCGen)
forall g.
RandomGen g =>
CTreeRoot' Identity MonoRef -> Name -> g -> (Term, g)
Cuddle.generateCBORTerm' (CuddleData -> CTreeRoot' Identity MonoRef
cddl CuddleData
cd) Name
n) QCGen
gen
   in (Term -> Expectation) -> [Term] -> Expectation
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Term -> Expectation
withTerm [Term]
terms

-- | Verify that random data generated is:
--
-- * Decoded successfully into a Haskell type using the decoder in `Trip` and the version
--   supplied
--
-- * When reencoded conforms produces a valid `FlatTerm`
--
-- * When decoded again from the bytes produced by the encoder matches the type exactly
--   when it was decoded from random bytes
roundTripExample ::
  (HasCallStack, Show a, Eq a) =>
  T.Text ->
  -- | Version to use for decoding
  Version ->
  -- | Version to use for encoding
  Version ->
  -- | Decode/encoder that needs tsting
  Trip a a ->
  -- | Randomly generated data and the CDDL spec
  CBOR.Term ->
  Expectation
roundTripExample :: forall a.
(HasCallStack, Show a, Eq a) =>
Text -> Version -> Version -> Trip a a -> Term -> Expectation
roundTripExample Text
lbl Version
encVersion Version
decVersion trip :: Trip a a
trip@Trip {forall s. Decoder s a
tripDecoder :: forall s. Decoder s a
tripDecoder :: forall a b. Trip a b -> forall s. Decoder s b
tripDecoder} Term
term =
  let
    encoding :: Encoding
encoding = Term -> Encoding
CBOR.encodeTerm Term
term
    initCborBytes :: ByteString
initCborBytes = Encoding -> ByteString
CBOR.toLazyByteString Encoding
encoding
    mkFailure :: Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure =
      Version
-> Version
-> Encoding
-> ByteString
-> Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
RoundTripFailure Version
encVersion Version
decVersion Encoding
encoding ByteString
initCborBytes
   in
    case Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
decVersion Text
lbl Decoder s a
forall s. Decoder s a
tripDecoder ByteString
initCborBytes of
      Left DecoderError
decErr -> HasCallStack => Encoding -> RoundTripFailure -> Expectation
Encoding -> RoundTripFailure -> Expectation
cddlFailure Encoding
encoding (RoundTripFailure -> Expectation)
-> RoundTripFailure -> Expectation
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Maybe ByteString
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing (DecoderError -> Maybe DecoderError
forall a. a -> Maybe a
Just DecoderError
decErr)
      Right a
val ->
        case Text
-> Version
-> Version
-> Trip a a
-> a
-> Either RoundTripFailure (a, Encoding, ByteString)
forall a b.
Eq b =>
Text
-> Version
-> Version
-> Trip a b
-> a
-> Either RoundTripFailure (b, Encoding, ByteString)
embedTripLabelExtra Text
lbl Version
encVersion Version
decVersion Trip a a
trip a
val of
          Right (a
val', Encoding
_encoding, ByteString
_encodedBytes) ->
            a
val' a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
val
          Left RoundTripFailure
embedErr -> HasCallStack => Encoding -> RoundTripFailure -> Expectation
Encoding -> RoundTripFailure -> Expectation
cddlFailure Encoding
encoding RoundTripFailure
embedErr

-- | Same as `roundTripExample`, but works for decoders that are wrapped into
-- `Annotator`
roundTripAnnExample ::
  (HasCallStack, Show a, Eq a) =>
  T.Text ->
  -- | Version to use for decoding
  Version ->
  -- | Version to use for encoding
  Version ->
  -- | Decode/encoder that needs tsting
  Trip a (Annotator a) ->
  -- | Randomly generated data and the CDDL spec
  CBOR.Term ->
  Expectation
roundTripAnnExample :: forall a.
(HasCallStack, Show a, Eq a) =>
Text
-> Version
-> Version
-> Trip a (Annotator a)
-> Term
-> Expectation
roundTripAnnExample Text
lbl Version
encVersion Version
decVersion Trip {a -> Encoding
tripEncoder :: a -> Encoding
tripEncoder :: forall a b. Trip a b -> a -> Encoding
tripEncoder, forall s. Decoder s (Annotator a)
tripDecoder :: forall a b. Trip a b -> forall s. Decoder s b
tripDecoder :: forall s. Decoder s (Annotator a)
tripDecoder} Term
term =
  let
    encoding :: Encoding
encoding = Term -> Encoding
CBOR.encodeTerm Term
term
    initCborBytes :: ByteString
initCborBytes = Encoding -> ByteString
CBOR.toLazyByteString Encoding
encoding
    mkFailure :: Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure =
      Version
-> Version
-> Encoding
-> ByteString
-> Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
RoundTripFailure Version
encVersion Version
decVersion Encoding
encoding ByteString
initCborBytes
   in
    case Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
decVersion Text
lbl Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
tripDecoder ByteString
initCborBytes of
      Left DecoderError
decErr -> HasCallStack => Encoding -> RoundTripFailure -> Expectation
Encoding -> RoundTripFailure -> Expectation
cddlFailure Encoding
encoding (RoundTripFailure -> Expectation)
-> RoundTripFailure -> Expectation
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Maybe ByteString
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing (DecoderError -> Maybe DecoderError
forall a. a -> Maybe a
Just DecoderError
decErr)
      Right a
val ->
        let enc :: Encoding
enc = Version -> Encoding -> Encoding
toPlainEncoding Version
encVersion (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ a -> Encoding
tripEncoder a
val
         in case Text
-> Version
-> Version
-> (forall s. Decoder s (Annotator a))
-> Encoding
-> Either RoundTripFailure (a, ByteString)
forall t.
Text
-> Version
-> Version
-> (forall s. Decoder s (Annotator t))
-> Encoding
-> Either RoundTripFailure (t, ByteString)
decodeAnnExtra Text
lbl Version
encVersion Version
decVersion Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
tripDecoder Encoding
enc of
              Right (a
val', ByteString
_encodedBytes) ->
                a
val' a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
val
              Left RoundTripFailure
embedErr -> HasCallStack => Encoding -> RoundTripFailure -> Expectation
Encoding -> RoundTripFailure -> Expectation
cddlFailure Encoding
encoding RoundTripFailure
embedErr

cddlFailure :: HasCallStack => CBOR.Encoding -> RoundTripFailure -> Expectation
cddlFailure :: HasCallStack => Encoding -> RoundTripFailure -> Expectation
cddlFailure Encoding
encoding RoundTripFailure
err =
  HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
    [String] -> String
unlines
      [ String
"Failed Cddl RoundTrip verification:"
      , RoundTripFailure -> String
forall a. Show a => a -> String
show RoundTripFailure
err
      , String
"Generated diag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Encoding -> String
CBOR.prettyHexEnc Encoding
encoding
      ]

--------------------------------------------------------------------------------
-- Writing specs to a file
--------------------------------------------------------------------------------

-- | Write a Huddle specification to a file at the given path
writeSpec :: Cuddle.Huddle -> FilePath -> IO ()
writeSpec :: Huddle -> String -> Expectation
writeSpec Huddle
hddl String
path =
  let cddl :: CDDL
cddl = Huddle -> CDDL
Cuddle.toCDDL Huddle
hddl
      preface :: String
preface = String
"; This file was auto-generated from huddle. Please do not modify it directly!"
   in String -> IOMode -> (Handle -> Expectation) -> Expectation
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
WriteMode ((Handle -> Expectation) -> Expectation)
-> (Handle -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
        Handle -> String -> Expectation
hPutStrLn Handle
h String
preface
        Handle -> Doc Any -> Expectation
forall ann. Handle -> Doc ann -> Expectation
hPutDoc Handle
h (CDDL -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. CDDL -> Doc ann
pretty CDDL
cddl)
        -- Write an empty line at the end of the file
        Handle -> String -> Expectation
hPutStrLn Handle
h String
""