module Test.Cleveland.Doc.Lorentz
(
testLorentzDoc
, testDeclaresParameter
, testEachEntrypointIsDescribed
, testParamBuildingStepsAreFinalized
, testAllEntrypointsAreCallable
, testAllErrorsBelongToEntrypoints
, module Test.Cleveland.Doc.Common
) where
import Data.Typeable (typeRep)
import Fmt (Buildable(..), blockListF, fmt, nameF, (+|), (|+))
import Test.HUnit (assertBool, assertFailure)
import Lorentz.Entrypoints.Doc
import Lorentz.Errors
import Morley.Michelson.Doc
import Morley.Util.Markdown
import Morley.Util.Text (dquotes)
import Test.Cleveland.Doc.Common
import Test.Cleveland.Doc.Michelson (testDocBasic)
data DocEpDescription
= DocEpDescription DDescription
| DocEpReference DEntrypointReference
instance Buildable DocEpDescription where
build :: DocEpDescription -> Builder
build = \case
DocEpDescription (DDescription Builder
txt) ->
Builder
"description: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
txt
DocEpReference (DEntrypointReference Text
name (Anchor Text
anchor)) ->
Builder
"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 -> 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
<> Builder
")"
lookupDocEpDescription :: DocBlock -> [DocEpDescription]
lookupDocEpDescription :: DocBlock -> [DocEpDescription]
lookupDocEpDescription 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 String
"Contract parameter is documented" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool String
"No doc items describing contract parameter found" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
(Element [(Maybe SomeDocItem, DocBlock)] -> Bool)
-> [(Maybe SomeDocItem, DocBlock)] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any Element [(Maybe SomeDocItem, DocBlock)] -> Bool
forall {b}. (Maybe SomeDocItem, b) -> Bool
check (ContractDoc -> [(Maybe SomeDocItem, DocBlock)]
allContractLayers ContractDoc
contractDoc)
where
check :: (Maybe SomeDocItem, b) -> Bool
check (Maybe SomeDocItem
Nothing, b
_) = Bool
False
check (Just SomeDocItem
sdi, b
_) =
case SomeDocItem
sdi of
DEntrypointDocItem DEntrypoint kind
_ -> Bool
True
SomeDocItem
_ -> Bool
False
testNoAdjacentEpDescriptions :: DocTest
testNoAdjacentEpDescriptions :: DocTest
testNoAdjacentEpDescriptions =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"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 ->
[(Maybe SomeDocItem, DocBlock)]
-> (Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ (ContractDoc -> [(Maybe SomeDocItem, DocBlock)]
allContractLayers ContractDoc
contractDoc) ((Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion)
-> (Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion
forall a b. (a -> b) -> a -> b
$ \(Maybe SomeDocItem
_, DocBlock
block) ->
case DocBlock -> [DocEpDescription]
lookupDocEpDescription DocBlock
block of
ds :: [DocEpDescription]
ds@(DocEpDescription
_ : DocEpDescription
_ : [DocEpDescription]
_) ->
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 Builder
"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
dquotes (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)
[DocEpDescription]
_ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
testEachEntrypointIsDescribed :: DocTest
testEachEntrypointIsDescribed :: DocTest
testEachEntrypointIsDescribed =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"Each entrypoint has 'DDescription'" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc -> do
[Text]
missingDescs :: [Text] <-
([Maybe Text] -> [Text]) -> IO [Maybe Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe Text] -> IO [Text])
-> ([IO (Maybe Text)] -> IO [Maybe Text])
-> [IO (Maybe Text)]
-> IO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO (Maybe Text)] -> IO [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (Maybe Text)] -> IO [Text]) -> [IO (Maybe Text)] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ ContractDoc -> [(Maybe SomeDocItem, DocBlock)]
allContractLayers ContractDoc
contractDoc [(Maybe SomeDocItem, DocBlock)]
-> ((Maybe SomeDocItem, DocBlock) -> IO (Maybe Text))
-> [IO (Maybe Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\(Maybe SomeDocItem
mDocItem, DocBlock
block) -> MaybeT IO Text -> IO (Maybe Text)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Text -> IO (Maybe Text))
-> MaybeT IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
DEntrypointDocItem DEntrypoint kind
dep <- 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
[] <- [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
Text -> MaybeT IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (DEntrypoint kind -> Text
forall kind. DEntrypoint kind -> Text
depName DEntrypoint kind
dep)
case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Text]
missingDescs of
Maybe (NonEmpty Text)
Nothing -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
Just NonEmpty Text
descs ->
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
"Descriptions for the following entrypoints are not found: \n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
NonEmpty Text -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF NonEmpty Text
descs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Builder
"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 String
"'finalizeParamCallingDoc' is applied" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc -> do
[DEntrypointArg]
-> (Element [DEntrypointArg] -> Assertion) -> Assertion
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ (ContractDoc -> [DEntrypointArg]
forall d. DocItem d => ContractDoc -> [d]
allContractDocItems ContractDoc
contractDoc) ((Element [DEntrypointArg] -> Assertion) -> Assertion)
-> (Element [DEntrypointArg] -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \DEntrypointArg{[ParamBuildingStep]
Maybe SomeEntrypointArg
epaBuilding :: DEntrypointArg -> [ParamBuildingStep]
epaArg :: DEntrypointArg -> Maybe SomeEntrypointArg
epaBuilding :: [ParamBuildingStep]
epaArg :: Maybe SomeEntrypointArg
..} ->
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
String
"Found unfinalized param building steps, \
\'How to call this entrypoint' section will not be acknowledged of \
\contract entrypoints coming from field annotations and may be incorrect.\n\
\Do you pick documentation of the entire 'Contract', not just contract code? \
\If the latter is necessary, please call 'finalizeParamCallingDoc' manually."
testAllEntrypointsAreCallable :: DocTest
testAllEntrypointsAreCallable :: DocTest
testAllEntrypointsAreCallable =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"All entrypoints are callable" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
[DEntrypointArg]
-> (Element [DEntrypointArg] -> Assertion) -> Assertion
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ (ContractDoc -> [DEntrypointArg]
forall d. DocItem d => ContractDoc -> [d]
allContractDocItems ContractDoc
contractDoc) ((Element [DEntrypointArg] -> Assertion) -> Assertion)
-> (Element [DEntrypointArg] -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \DEntrypointArg{[ParamBuildingStep]
Maybe SomeEntrypointArg
epaBuilding :: [ParamBuildingStep]
epaArg :: Maybe SomeEntrypointArg
epaBuilding :: DEntrypointArg -> [ParamBuildingStep]
epaArg :: DEntrypointArg -> Maybe SomeEntrypointArg
..} ->
[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 [ParamBuildingStep]
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
$
Builder
"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)
Element [ParamBuildingStep]
_ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
testAllErrorsBelongToEntrypoints :: DocTest
testAllErrorsBelongToEntrypoints :: DocTest
testAllErrorsBelongToEntrypoints =
HasCallStack =>
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
String -> (HasCallStack => ContractDoc -> Assertion) -> DocTest
mkDocTest String
"All errors belong to some entrypoint" ((HasCallStack => ContractDoc -> Assertion) -> DocTest)
-> (HasCallStack => ContractDoc -> Assertion) -> DocTest
forall a b. (a -> b) -> a -> b
$
\ContractDoc
contractDoc ->
[(Maybe SomeDocItem, DocBlock)]
-> (Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ (ContractDoc -> [(Maybe SomeDocItem, DocBlock)]
allContractLayers ContractDoc
contractDoc) ((Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion)
-> (Element [(Maybe SomeDocItem, DocBlock)] -> Assertion)
-> Assertion
forall a b. (a -> b) -> a -> b
$ \(Maybe SomeDocItem
mGroup, DocBlock
block) ->
case forall d. DocItem d => DocBlock -> Maybe (NonEmpty d)
lookupDocBlockSection @DThrows DocBlock
block of
Maybe (NonEmpty DThrows)
Nothing -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
Just (DThrows (Proxy e
_ :: Proxy err) :| [DThrows]
_) ->
if | Just DEntrypointDocItem{} <- Maybe SomeDocItem
mGroup -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
| ErrorClass -> Bool
isInternalErrorClass (forall e. ErrorHasDoc e => ErrorClass
errorDocClass @err) -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass
| Bool
otherwise -> 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
"Found an error `" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show @Text (Proxy e -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @err)) Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"` \
\thrown outside of any entrypoint.\n\n\
\If this should not belong to any existing entrypoint,\n\
\consider marking the code as common for other entrypoints using\n\
\CommonContractBehaviourKind or CommonEntrypointsBehaviourKind."
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
, DocTest
testAllErrorsBelongToEntrypoints
]
]