module Lorentz.Test.Doc
(
testLorentzDoc
, testDeclaresParameter
, testEachEntrypointIsDescribed
, testParamBuildingStepsAreFinalized
, testAllEntrypointsAreCallable
, module Michelson.Doc.Test
) where
import Fmt (Buildable(..), blockListF, fmt, nameF, pretty)
import Test.HUnit (assertBool, assertFailure)
import Lorentz.EntryPoints.Doc
import Michelson.Doc
import Michelson.Doc.Test
import Util.Markdown
import Util.Typeable
data DocEpDescription
= DocEpDescription DDescription
| DocEpReference DEntryPointReference
instance Buildable DocEpDescription where
build :: DocEpDescription -> Builder
build = \case
DocEpDescription (DDescription txt :: Builder
txt) ->
"description: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
txt
DocEpReference (DEntryPointReference name :: Text
name (Anchor anchor :: Text
anchor)) ->
"reference \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "\" (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build Text
anchor Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ")"
lookupDocEpDescription :: DocBlock -> [DocEpDescription]
lookupDocEpDescription :: DocBlock -> [DocEpDescription]
lookupDocEpDescription block :: DocBlock
block = [[DocEpDescription]] -> [DocEpDescription]
forall a. Monoid a => [a] -> a
mconcat
[ (DDescription -> DocEpDescription)
-> [DDescription] -> [DocEpDescription]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DDescription -> DocEpDescription
DocEpDescription ([DDescription] -> [DocEpDescription])
-> (Maybe (NonEmpty DDescription) -> [DDescription])
-> Maybe (NonEmpty DDescription)
-> [DocEpDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DDescription]
-> (NonEmpty DDescription -> [DDescription])
-> Maybe (NonEmpty DDescription)
-> [DDescription]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty DDescription -> [DDescription]
forall t. Container t => t -> [Element t]
toList (Maybe (NonEmpty DDescription) -> [DocEpDescription])
-> Maybe (NonEmpty DDescription) -> [DocEpDescription]
forall a b. (a -> b) -> a -> b
$ DocBlock -> Maybe (NonEmpty DDescription)
forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection DocBlock
block
, (DEntryPointReference -> DocEpDescription)
-> [DEntryPointReference] -> [DocEpDescription]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map DEntryPointReference -> DocEpDescription
DocEpReference ([DEntryPointReference] -> [DocEpDescription])
-> (Maybe (NonEmpty DEntryPointReference)
-> [DEntryPointReference])
-> Maybe (NonEmpty DEntryPointReference)
-> [DocEpDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DEntryPointReference]
-> (NonEmpty DEntryPointReference -> [DEntryPointReference])
-> Maybe (NonEmpty DEntryPointReference)
-> [DEntryPointReference]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty DEntryPointReference -> [DEntryPointReference]
forall t. Container t => t -> [Element t]
toList (Maybe (NonEmpty DEntryPointReference) -> [DocEpDescription])
-> Maybe (NonEmpty DEntryPointReference) -> [DocEpDescription]
forall a b. (a -> b) -> a -> b
$ DocBlock -> Maybe (NonEmpty DEntryPointReference)
forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection DocBlock
block
]
testDeclaresParameter :: DocTest
testDeclaresParameter :: DocTest
testDeclaresParameter =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "Contract parameter is documented" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\contractDoc :: ContractDoc
contractDoc ->
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool "No doc items describing contract parameter found" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
[Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ContractDoc -> (Maybe SomeDocItem -> DocBlock -> Bool) -> [Bool]
forall r.
ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer ContractDoc
contractDoc Maybe SomeDocItem -> DocBlock -> Bool
forall p. Maybe SomeDocItem -> p -> Bool
check
where
check :: Maybe SomeDocItem -> p -> Bool
check Nothing _ = Bool
False
check (Just sdi :: SomeDocItem
sdi) _ =
case SomeDocItem
sdi of
SomeDocItem (d -> Maybe (DEntryPoint DummyPhantomType)
forall k (c :: k -> *) x.
(Typeable x, Typeable c,
forall (phantom1 :: k) (phantom2 :: k).
Coercible (c phantom1) (c phantom2)) =>
x -> Maybe (c DummyPhantomType)
castIgnoringPhantom -> Just DEntryPoint{}) -> Bool
True
_ -> Bool
False
testNoAdjacentEpDescriptions :: DocTest
testNoAdjacentEpDescriptions :: DocTest
testNoAdjacentEpDescriptions =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "No two 'DDescription' appear under the same group" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\contractDoc :: ContractDoc
contractDoc ->
[Assertion] -> Assertion
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([Assertion] -> Assertion)
-> ((Maybe SomeDocItem -> DocBlock -> Assertion) -> [Assertion])
-> (Maybe SomeDocItem -> DocBlock -> Assertion)
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc
-> (Maybe SomeDocItem -> DocBlock -> Assertion) -> [Assertion]
forall r.
ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer ContractDoc
contractDoc ((Maybe SomeDocItem -> DocBlock -> Assertion) -> Assertion)
-> (Maybe SomeDocItem -> DocBlock -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \_ block :: DocBlock
block ->
case DocBlock -> [DocEpDescription]
lookupDocEpDescription DocBlock
block of
ds :: [DocEpDescription]
ds@(_ : _ : _) ->
String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion)
-> (Builder -> String) -> Builder -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Assertion) -> Builder -> Assertion
forall a b. (a -> b) -> a -> b
$
Builder -> Builder -> Builder
nameF "Found multiple adjacent entrypoint descriptions" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (DocEpDescription -> Builder) -> [DocEpDescription] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Builder -> Builder
forall a. (Semigroup a, IsString a) => a -> a
quotes (Builder -> Builder)
-> (DocEpDescription -> Builder) -> DocEpDescription -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocEpDescription -> Builder
forall p. Buildable p => p -> Builder
build) ([DocEpDescription] -> [Element [DocEpDescription]]
forall t. Container t => t -> [Element t]
toList [DocEpDescription]
ds)
_ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
where
quotes :: a -> a
quotes t :: a
t = "\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "\""
testEachEntrypointIsDescribed :: DocTest
testEachEntrypointIsDescribed :: DocTest
testEachEntrypointIsDescribed =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "Each entrypoint has 'DDescription'" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\contractDoc :: ContractDoc
contractDoc ->
[IO (Maybe Any)] -> Assertion
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([IO (Maybe Any)] -> Assertion)
-> ((Maybe SomeDocItem -> DocBlock -> IO (Maybe Any))
-> [IO (Maybe Any)])
-> (Maybe SomeDocItem -> DocBlock -> IO (Maybe Any))
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc
-> (Maybe SomeDocItem -> DocBlock -> IO (Maybe Any))
-> [IO (Maybe Any)]
forall r.
ContractDoc -> (Maybe SomeDocItem -> DocBlock -> r) -> [r]
forEachContractLayer ContractDoc
contractDoc ((Maybe SomeDocItem -> DocBlock -> IO (Maybe Any)) -> Assertion)
-> (Maybe SomeDocItem -> DocBlock -> IO (Maybe Any)) -> Assertion
forall a b. (a -> b) -> a -> b
$ \mDocItem :: Maybe SomeDocItem
mDocItem block :: DocBlock
block ->
MaybeT IO Any -> IO (Maybe Any)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Any -> IO (Maybe Any))
-> MaybeT IO Any -> IO (Maybe Any)
forall a b. (a -> b) -> a -> b
$ do
SomeDocItem docItem :: d
docItem <- IO (Maybe SomeDocItem) -> MaybeT IO SomeDocItem
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe SomeDocItem) -> MaybeT IO SomeDocItem)
-> (Maybe SomeDocItem -> IO (Maybe SomeDocItem))
-> Maybe SomeDocItem
-> MaybeT IO SomeDocItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SomeDocItem -> IO (Maybe SomeDocItem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SomeDocItem -> MaybeT IO SomeDocItem)
-> Maybe SomeDocItem -> MaybeT IO SomeDocItem
forall a b. (a -> b) -> a -> b
$ Maybe SomeDocItem
mDocItem
dep :: DEntryPoint DummyPhantomType
dep@DEntryPoint{} <- IO (Maybe (DEntryPoint DummyPhantomType))
-> MaybeT IO (DEntryPoint DummyPhantomType)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (DEntryPoint DummyPhantomType))
-> MaybeT IO (DEntryPoint DummyPhantomType))
-> (Maybe (DEntryPoint DummyPhantomType)
-> IO (Maybe (DEntryPoint DummyPhantomType)))
-> Maybe (DEntryPoint DummyPhantomType)
-> MaybeT IO (DEntryPoint DummyPhantomType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (DEntryPoint DummyPhantomType)
-> IO (Maybe (DEntryPoint DummyPhantomType))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DEntryPoint DummyPhantomType)
-> MaybeT IO (DEntryPoint DummyPhantomType))
-> Maybe (DEntryPoint DummyPhantomType)
-> MaybeT IO (DEntryPoint DummyPhantomType)
forall a b. (a -> b) -> a -> b
$ d -> Maybe (DEntryPoint DummyPhantomType)
forall k (c :: k -> *) x.
(Typeable x, Typeable c,
forall (phantom1 :: k) (phantom2 :: k).
Coercible (c phantom1) (c phantom2)) =>
x -> Maybe (c DummyPhantomType)
castIgnoringPhantom d
docItem
[] <- [DocEpDescription] -> MaybeT IO [DocEpDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DocEpDescription] -> MaybeT IO [DocEpDescription])
-> [DocEpDescription] -> MaybeT IO [DocEpDescription]
forall a b. (a -> b) -> a -> b
$ DocBlock -> [DocEpDescription]
lookupDocEpDescription DocBlock
block
IO (Maybe Any) -> MaybeT IO Any
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Any) -> MaybeT IO Any)
-> (String -> IO (Maybe Any)) -> String -> MaybeT IO Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe Any)
forall a. HasCallStack => String -> IO a
assertFailure (String -> MaybeT IO Any) -> String -> MaybeT IO Any
forall a b. (a -> b) -> a -> b
$
"Entrypoint '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (DEntryPoint DummyPhantomType -> Text
forall kind. DEntryPoint kind -> Text
depName DEntryPoint DummyPhantomType
dep) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "' does not contain \
\any description.\n\
\Put e.g. `doc $ DDescription \"text\"` in the entrypoint logic to \
\fix this."
testParamBuildingStepsAreFinalized :: DocTest
testParamBuildingStepsAreFinalized :: DocTest
testParamBuildingStepsAreFinalized =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "'finalizeParamCallingDoc' is applied" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\contractDoc :: ContractDoc
contractDoc ->
[Assertion] -> Assertion
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([Assertion] -> Assertion)
-> ((DEntryPointArg -> Assertion) -> [Assertion])
-> (DEntryPointArg -> Assertion)
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc -> (DEntryPointArg -> Assertion) -> [Assertion]
forall d r. DocItem d => ContractDoc -> (d -> r) -> [r]
forEachContractDocItem ContractDoc
contractDoc ((DEntryPointArg -> Assertion) -> Assertion)
-> (DEntryPointArg -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \DEntryPointArg{..} ->
Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ParamBuildingStep] -> Bool
areFinalizedParamBuildingSteps [ParamBuildingStep]
epaBuilding) (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$
String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure
"Found unfinalized param building steps, \
\'How to call this entrypoint' section may be incorrect.\n\
\Have you applied 'finalizeParamCallingDoc' to your contract?"
testAllEntrypointsAreCallable :: DocTest
testAllEntrypointsAreCallable :: DocTest
testAllEntrypointsAreCallable =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest "All entrypoints are callable" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\contractDoc :: ContractDoc
contractDoc ->
[Assertion] -> Assertion
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([Assertion] -> Assertion)
-> ((DEntryPointArg -> Assertion) -> [Assertion])
-> (DEntryPointArg -> Assertion)
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractDoc -> (DEntryPointArg -> Assertion) -> [Assertion]
forall d r. DocItem d => ContractDoc -> (d -> r) -> [r]
forEachContractDocItem ContractDoc
contractDoc ((DEntryPointArg -> Assertion) -> Assertion)
-> (DEntryPointArg -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \DEntryPointArg{..} ->
[ParamBuildingStep]
-> (Element [ParamBuildingStep] -> Assertion) -> Assertion
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [ParamBuildingStep]
epaBuilding ((Element [ParamBuildingStep] -> Assertion) -> Assertion)
-> (Element [ParamBuildingStep] -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \case
PbsUncallable pbs ->
String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion)
-> (Builder -> String) -> Builder -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Assertion) -> Builder -> Assertion
forall a b. (a -> b) -> a -> b
$
"Found an uncallable entrypoint.\n\
\Dummy parameter building steps for it: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [ParamBuildingStep] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF ([ParamBuildingStep] -> [ParamBuildingStep]
forall a. [a] -> [a]
reverse [ParamBuildingStep]
pbs)
_ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
testLorentzDoc :: [DocTest]
testLorentzDoc :: [DocTest]
testLorentzDoc = [[DocTest]] -> [DocTest]
forall a. Monoid a => [a] -> a
mconcat
[ [DocTest]
testDocBasic
, [ DocTest
testDeclaresParameter
, DocTest
testNoAdjacentEpDescriptions
, DocTest
testEachEntrypointIsDescribed
, DocTest
testParamBuildingStepsAreFinalized
, DocTest
testAllEntrypointsAreCallable
]
]