{-# LANGUAGE LambdaCase #-}

{- |
Module      : Conformance.EvidencePage
Description : The published evidence page, computed from receipts
License     : Apache-2.0

The conformance evidence page is a function of four inputs and nothing
else: the requirement inventory (@rows.json@), the application model
revision (@conformance/model-revision@), and one snapshot of run output
for one stated code revision — the conformance run receipts and the
backend contract suite's per-adapter results, copied from the CI runs
that produced them.

No state is typed into the page. A requirement reads executed or
partial only through 'effectiveState', from a receipt whose base is the
snapshot's stated base; every other requirement is listed by its
requirement text under the plan @rows.json@ declares. A snapshot whose
receipts or results name another base, were recorded on a dirty tree,
name an unknown requirement, or report a contract case list that is not
the same for every adapter is refused rather than rendered.

The documentation check renders the page again from the committed
inputs and compares it byte for byte with the committed page and its
speech companion; any difference fails the check.
-}
module Conformance.EvidencePage
    ( -- * Snapshot
      Snapshot (..)
    , Source (..)
    , ContractResult (..)
    , ContractEvidence (..)
    , ContractOutcome (..)
    , loadSnapshot

      -- * Rendering
    , RenderedPage (..)
    , renderEvidencePage

      -- * The command
    , runEvidencePage
    ) where

import Conformance.Edge.Permanent qualified as Permanent
import Control.Monad (unless)
import Data.Aeson
    ( FromJSON (..)
    , Value (..)
    , eitherDecode
    , eitherDecodeStrict
    , encode
    , object
    , withObject
    , withText
    , (.:)
    , (.:?)
    , (.=)
    )
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as BS8
import Data.ByteString.Lazy qualified as BSL
import Data.Char (isAlphaNum)
import Data.List (nub, sort, sortOn)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import System.Directory
    ( doesDirectoryExist
    , doesFileExist
    , listDirectory
    )
import System.Exit (exitFailure)
import System.FilePath (takeExtension, (</>))
import System.IO (hPutStrLn, stderr)

import Conformance.Receipt
    ( Receipt (..)
    , Verdict (..)
    , loadReceipts
    , unmetReading
    , unmetRuling
    )
import Conformance.Rows
    ( Row (..)
    , RowState (..)
    , ShownState (..)
    , effectiveState
    , loadRows
    )
import Data.Maybe (isNothing)

-- | Where the snapshot's files were copied from: one CI run's artifact.
data Source = Source
    { Source -> Text
sourceWorkflow :: !Text
    , Source -> Text
sourceRun :: !Text
    , Source -> Text
sourceArtifact :: !Text
    }
    deriving stock (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Source -> ShowS
showsPrec :: Int -> Source -> ShowS
$cshow :: Source -> String
show :: Source -> String
$cshowList :: [Source] -> ShowS
showList :: [Source] -> ShowS
Show, Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
/= :: Source -> Source -> Bool
Eq)

instance FromJSON Source where
    parseJSON :: Value -> Parser Source
parseJSON = String -> (KeyMap Value -> Parser Source) -> Value -> Parser Source
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"Source" ((KeyMap Value -> Parser Source) -> Value -> Parser Source)
-> (KeyMap Value -> Parser Source) -> Value -> Parser Source
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o ->
        Text -> Text -> Text -> Source
Source (Text -> Text -> Text -> Source)
-> Parser Text -> Parser (Text -> Text -> Source)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"workflow" Parser (Text -> Text -> Source)
-> Parser Text -> Parser (Text -> Source)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"run" Parser (Text -> Source) -> Parser Text -> Parser Source
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"artifact"

-- | The evidence class of one contract-suite run. There is no public chain.
data ContractEvidence = ContractTestAdapter | ContractDevNet
    deriving stock (Int -> ContractEvidence -> ShowS
[ContractEvidence] -> ShowS
ContractEvidence -> String
(Int -> ContractEvidence -> ShowS)
-> (ContractEvidence -> String)
-> ([ContractEvidence] -> ShowS)
-> Show ContractEvidence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractEvidence -> ShowS
showsPrec :: Int -> ContractEvidence -> ShowS
$cshow :: ContractEvidence -> String
show :: ContractEvidence -> String
$cshowList :: [ContractEvidence] -> ShowS
showList :: [ContractEvidence] -> ShowS
Show, ContractEvidence -> ContractEvidence -> Bool
(ContractEvidence -> ContractEvidence -> Bool)
-> (ContractEvidence -> ContractEvidence -> Bool)
-> Eq ContractEvidence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractEvidence -> ContractEvidence -> Bool
== :: ContractEvidence -> ContractEvidence -> Bool
$c/= :: ContractEvidence -> ContractEvidence -> Bool
/= :: ContractEvidence -> ContractEvidence -> Bool
Eq, Eq ContractEvidence
Eq ContractEvidence =>
(ContractEvidence -> ContractEvidence -> Ordering)
-> (ContractEvidence -> ContractEvidence -> Bool)
-> (ContractEvidence -> ContractEvidence -> Bool)
-> (ContractEvidence -> ContractEvidence -> Bool)
-> (ContractEvidence -> ContractEvidence -> Bool)
-> (ContractEvidence -> ContractEvidence -> ContractEvidence)
-> (ContractEvidence -> ContractEvidence -> ContractEvidence)
-> Ord ContractEvidence
ContractEvidence -> ContractEvidence -> Bool
ContractEvidence -> ContractEvidence -> Ordering
ContractEvidence -> ContractEvidence -> ContractEvidence
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
$ccompare :: ContractEvidence -> ContractEvidence -> Ordering
compare :: ContractEvidence -> ContractEvidence -> Ordering
$c< :: ContractEvidence -> ContractEvidence -> Bool
< :: ContractEvidence -> ContractEvidence -> Bool
$c<= :: ContractEvidence -> ContractEvidence -> Bool
<= :: ContractEvidence -> ContractEvidence -> Bool
$c> :: ContractEvidence -> ContractEvidence -> Bool
> :: ContractEvidence -> ContractEvidence -> Bool
$c>= :: ContractEvidence -> ContractEvidence -> Bool
>= :: ContractEvidence -> ContractEvidence -> Bool
$cmax :: ContractEvidence -> ContractEvidence -> ContractEvidence
max :: ContractEvidence -> ContractEvidence -> ContractEvidence
$cmin :: ContractEvidence -> ContractEvidence -> ContractEvidence
min :: ContractEvidence -> ContractEvidence -> ContractEvidence
Ord)

instance FromJSON ContractEvidence where
    parseJSON :: Value -> Parser ContractEvidence
parseJSON = String
-> (Text -> Parser ContractEvidence)
-> Value
-> Parser ContractEvidence
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ContractEvidence" ((Text -> Parser ContractEvidence)
 -> Value -> Parser ContractEvidence)
-> (Text -> Parser ContractEvidence)
-> Value
-> Parser ContractEvidence
forall a b. (a -> b) -> a -> b
$ \case
        Text
"test-adapter" -> ContractEvidence -> Parser ContractEvidence
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractEvidence
ContractTestAdapter
        Text
"devnet" -> ContractEvidence -> Parser ContractEvidence
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractEvidence
ContractDevNet
        Text
other ->
            String -> Parser ContractEvidence
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                ( String
"evidence class "
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
other
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not one the contract suite runs: \
                       \test-adapter or devnet"
                )

-- | One contract case's result on one adapter.
data ContractOutcome
    = ContractPassed
    | ContractFailed !Text
    | ContractNotSupported !Text
    deriving stock (Int -> ContractOutcome -> ShowS
[ContractOutcome] -> ShowS
ContractOutcome -> String
(Int -> ContractOutcome -> ShowS)
-> (ContractOutcome -> String)
-> ([ContractOutcome] -> ShowS)
-> Show ContractOutcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractOutcome -> ShowS
showsPrec :: Int -> ContractOutcome -> ShowS
$cshow :: ContractOutcome -> String
show :: ContractOutcome -> String
$cshowList :: [ContractOutcome] -> ShowS
showList :: [ContractOutcome] -> ShowS
Show, ContractOutcome -> ContractOutcome -> Bool
(ContractOutcome -> ContractOutcome -> Bool)
-> (ContractOutcome -> ContractOutcome -> Bool)
-> Eq ContractOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractOutcome -> ContractOutcome -> Bool
== :: ContractOutcome -> ContractOutcome -> Bool
$c/= :: ContractOutcome -> ContractOutcome -> Bool
/= :: ContractOutcome -> ContractOutcome -> Bool
Eq)

-- | One line of the contract suite's results file.
data ContractResult = ContractResult
    { ContractResult -> Text
crBase :: !Text
    , ContractResult -> Bool
crDirty :: !Bool
    , ContractResult -> Text
crAdapter :: !Text
    , ContractResult -> ContractEvidence
crEvidence :: !ContractEvidence
    , ContractResult -> Text
crCase :: !Text
    , ContractResult -> Text
crKind :: !Text
    , ContractResult -> Text
crRequirement :: !Text
    , ContractResult -> ContractOutcome
crOutcome :: !ContractOutcome
    }
    deriving stock (Int -> ContractResult -> ShowS
[ContractResult] -> ShowS
ContractResult -> String
(Int -> ContractResult -> ShowS)
-> (ContractResult -> String)
-> ([ContractResult] -> ShowS)
-> Show ContractResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractResult -> ShowS
showsPrec :: Int -> ContractResult -> ShowS
$cshow :: ContractResult -> String
show :: ContractResult -> String
$cshowList :: [ContractResult] -> ShowS
showList :: [ContractResult] -> ShowS
Show, ContractResult -> ContractResult -> Bool
(ContractResult -> ContractResult -> Bool)
-> (ContractResult -> ContractResult -> Bool) -> Eq ContractResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractResult -> ContractResult -> Bool
== :: ContractResult -> ContractResult -> Bool
$c/= :: ContractResult -> ContractResult -> Bool
/= :: ContractResult -> ContractResult -> Bool
Eq)

instance FromJSON ContractResult where
    parseJSON :: Value -> Parser ContractResult
parseJSON = String
-> (KeyMap Value -> Parser ContractResult)
-> Value
-> Parser ContractResult
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"ContractResult" ((KeyMap Value -> Parser ContractResult)
 -> Value -> Parser ContractResult)
-> (KeyMap Value -> Parser ContractResult)
-> Value
-> Parser ContractResult
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
        outcome <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"outcome"
        reason <- o .:? "reason"
        result <- case (outcome :: Text, reason) of
            (Text
"passed", Maybe Text
Nothing) -> ContractOutcome -> Parser ContractOutcome
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractOutcome
ContractPassed
            (Text
"failed", Just Text
r) -> ContractOutcome -> Parser ContractOutcome
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ContractOutcome
ContractFailed Text
r)
            (Text
"not-supported", Just Text
r) -> ContractOutcome -> Parser ContractOutcome
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ContractOutcome
ContractNotSupported Text
r)
            (Text
"passed", Just Text
_) -> String -> Parser ContractOutcome
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"a passed case carries no reason"
            (Text
_, Maybe Text
Nothing) -> String -> Parser ContractOutcome
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"a " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
outcome String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" case names its reason")
            (Text, Maybe Text)
_ -> String -> Parser ContractOutcome
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown contract outcome: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
outcome)
        ContractResult
            <$> o .: "base"
            <*> o .: "dirty"
            <*> o .: "adapter"
            <*> o .: "evidence"
            <*> o .: "case"
            <*> o .: "kind"
            <*> o .: "requirement"
            <*> pure result

-- | Everything one snapshot directory holds.
data Snapshot = Snapshot
    { Snapshot -> Text
snapBase :: !Text
    -- ^ The code revision every receipt and result must name
    , Snapshot -> [Source]
snapSources :: ![Source]
    , Snapshot -> [Receipt]
snapReceipts :: ![Receipt]
    , Snapshot -> [String]
snapReceiptFiles :: ![FilePath]
    , Snapshot -> [ContractResult]
snapContract :: ![ContractResult]
    , Snapshot -> [String]
snapContractFiles :: ![FilePath]
    }
    deriving stock (Int -> Snapshot -> ShowS
[Snapshot] -> ShowS
Snapshot -> String
(Int -> Snapshot -> ShowS)
-> (Snapshot -> String) -> ([Snapshot] -> ShowS) -> Show Snapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Snapshot -> ShowS
showsPrec :: Int -> Snapshot -> ShowS
$cshow :: Snapshot -> String
show :: Snapshot -> String
$cshowList :: [Snapshot] -> ShowS
showList :: [Snapshot] -> ShowS
Show, Snapshot -> Snapshot -> Bool
(Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool) -> Eq Snapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Snapshot -> Snapshot -> Bool
== :: Snapshot -> Snapshot -> Bool
$c/= :: Snapshot -> Snapshot -> Bool
/= :: Snapshot -> Snapshot -> Bool
Eq)

data Manifest = Manifest Text [Source]

instance FromJSON Manifest where
    parseJSON :: Value -> Parser Manifest
parseJSON = String
-> (KeyMap Value -> Parser Manifest) -> Value -> Parser Manifest
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"Snapshot" ((KeyMap Value -> Parser Manifest) -> Value -> Parser Manifest)
-> (KeyMap Value -> Parser Manifest) -> Value -> Parser Manifest
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o ->
        Text -> [Source] -> Manifest
Manifest (Text -> [Source] -> Manifest)
-> Parser Text -> Parser ([Source] -> Manifest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"base" Parser ([Source] -> Manifest) -> Parser [Source] -> Parser Manifest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
o KeyMap Value -> Key -> Parser [Source]
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"sources"

{- | Read a snapshot directory: @snapshot.json@ (the stated base and the
CI runs the files were copied from), @receipts/@ (the conformance run's
receipt artifact, as downloaded) and @contract/@ (the contract suite's
results files, one JSON object per line).
-}
loadSnapshot :: FilePath -> IO (Either String Snapshot)
loadSnapshot :: String -> IO (Either String Snapshot)
loadSnapshot String
dir = do
    manifest <- ByteString -> Either String Manifest
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Manifest)
-> IO ByteString -> IO (Either String Manifest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BSL.readFile (String
dir String -> ShowS
</> String
"snapshot.json")
    receipts <- loadReceipts (dir </> "receipts")
    receiptFiles <- listed (dir </> "receipts")
    contractFiles <-
        filter ((== ".jsonl") . takeExtension)
            <$> listed (dir </> "contract")
    contract <-
        mapM (readResults . ((dir </> "contract") </>)) contractFiles
    pure $ do
        Manifest base sources <-
            either (Left . ("snapshot.json: " <>)) Right manifest
        rs <- receipts
        cs <- concat <$> sequence contract
        pure
            Snapshot
                { snapBase = base
                , snapSources = sources
                , snapReceipts = rs
                , snapReceiptFiles = receiptFiles
                , snapContract = cs
                , snapContractFiles = contractFiles
                }
  where
    listed :: String -> IO [String]
listed String
d = do
        exists <- String -> IO Bool
doesDirectoryExist String
d
        if exists then sort <$> listDirectory d else pure []
    readResults :: String -> IO (Either String [b])
readResults String
path = do
        content <- String -> IO ByteString
BS.readFile String
path
        pure
            . traverse (decodeLine path)
            . zip [1 :: Int ..]
            . filter (not . BS.null)
            $ BS8.lines content
    decodeLine :: String -> (a, ByteString) -> Either String b
decodeLine String
path (a
n, ByteString
line) =
        (String -> Either String b)
-> (b -> Either String b) -> Either String b -> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\String
e -> String -> Either String b
forall a b. a -> Either a b
Left (String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e))
            b -> Either String b
forall a b. b -> Either a b
Right
            (ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
line)

-- | The page and its speech companion, as the site publishes them.
data RenderedPage = RenderedPage
    { RenderedPage -> Text
renderedPage :: !Text
    , RenderedPage -> ByteString
renderedSpeech :: !BSL.ByteString
    -- ^ Without its source stamp; the caller stamps it with the page hash
    }

{- | Render the evidence page, or refuse the snapshot naming why. The
first argument is the application model revision.
-}
renderEvidencePage
    :: Text -> [Row] -> Snapshot -> Either String RenderedPage
renderEvidencePage :: Text -> [Row] -> Snapshot -> Either String RenderedPage
renderEvidencePage Text
model [Row]
rows Snapshot
snap = do
    [Row] -> Snapshot -> Either String ()
validateSnapshot [Row]
rows Snapshot
snap
    RenderedPage -> Either String RenderedPage
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Row] -> Snapshot -> RenderedPage
layout Text
model [Row]
rows Snapshot
snap)

validateSnapshot :: [Row] -> Snapshot -> Either String ()
validateSnapshot :: [Row] -> Snapshot -> Either String ()
validateSnapshot [Row]
rows Snapshot
snap = do
    Bool -> String -> Either String ()
whenL (Text -> Bool
T.null (Snapshot -> Text
snapBase Snapshot
snap)) String
"the snapshot states no base"
    Bool -> String -> Either String ()
whenL
        ([Receipt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Snapshot -> [Receipt]
snapReceipts Snapshot
snap))
        String
"the snapshot holds no conformance receipt"
    Bool -> String -> Either String ()
whenL
        ([ContractResult] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Snapshot -> [ContractResult]
snapContract Snapshot
snap))
        String
"the snapshot holds no contract result"
    (Receipt -> Either String ()) -> [Receipt] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Receipt -> Either String ()
receiptBound (Snapshot -> [Receipt]
snapReceipts Snapshot
snap)
    (ContractResult -> Either String ())
-> [ContractResult] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ContractResult -> Either String ()
resultBound (Snapshot -> [ContractResult]
snapContract Snapshot
snap)
    (Receipt -> Either String ()) -> [Receipt] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Receipt -> Either String ()
unmetStated (Snapshot -> [Receipt]
snapReceipts Snapshot
snap)
    Either String ()
sameCases
  where
    base :: Text
base = Snapshot -> Text
snapBase Snapshot
snap
    known :: [Text]
known = (Row -> Text) -> [Row] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Text
rowId [Row]
rows
    -- An unmet row is published only with the ruling that keeps it unmet.
    unmetStated :: Receipt -> Either String ()
unmetStated Receipt
r =
        Bool -> String -> Either String ()
whenL
            ( Receipt -> Verdict
receiptVerdict Receipt
r Verdict -> Verdict -> Bool
forall a. Eq a => a -> a -> Bool
== Verdict
UnmetByRuling
                Bool -> Bool -> Bool
&& Maybe UnmetRuling -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Maybe UnmetRuling
unmetRuling (Receipt -> Text
receiptRow Receipt
r))
            )
            ( String
"the receipt for "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptRow Receipt
r)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is unmet by a ruling no reader surface states"
            )
    receiptBound :: Receipt -> Either String ()
receiptBound Receipt
r = do
        Bool -> String -> Either String ()
whenL
            (Receipt -> Text
receiptRow Receipt
r Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
known)
            (String
"a receipt names unknown requirement " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptRow Receipt
r))
        Bool -> String -> Either String ()
whenL
            (Receipt -> Text
receiptBase Receipt
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
base)
            ( String
"the receipt for "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptRow Receipt
r)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" names base "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptBase Receipt
r)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", not the stated base "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
base
            )
        Bool -> String -> Either String ()
whenL
            (Receipt -> Bool
receiptDirty Receipt
r)
            ( String
"the receipt for "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptRow Receipt
r)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was recorded on a dirty tree"
            )
    resultBound :: ContractResult -> Either String ()
resultBound ContractResult
c = do
        Bool -> String -> Either String ()
whenL
            (ContractResult -> Text
crBase ContractResult
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
base)
            ( String
"the contract result for "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ContractResult -> Text
crAdapter ContractResult
c)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" / "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ContractResult -> Text
crCase ContractResult
c)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" names base "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ContractResult -> Text
crBase ContractResult
c)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", not the stated base "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
base
            )
        Bool -> String -> Either String ()
whenL
            (ContractResult -> Bool
crDirty ContractResult
c)
            ( String
"the contract result for "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ContractResult -> Text
crAdapter ContractResult
c)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" / "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ContractResult -> Text
crCase ContractResult
c)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was recorded on a dirty tree"
            )
    sameCases :: Either String ()
sameCases = do
        let byAdapter :: [(Text, [ContractResult])]
byAdapter = [ContractResult] -> [(Text, [ContractResult])]
adapterCases (Snapshot -> [ContractResult]
snapContract Snapshot
snap)
            caseLists :: [[Text]]
caseLists = ((Text, [ContractResult]) -> [Text])
-> [(Text, [ContractResult])] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((ContractResult -> Text) -> [ContractResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ContractResult -> Text
crCase ([ContractResult] -> [Text])
-> ((Text, [ContractResult]) -> [ContractResult])
-> (Text, [ContractResult])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [ContractResult]) -> [ContractResult]
forall a b. (a, b) -> b
snd) [(Text, [ContractResult])]
byAdapter
        ((Text, [ContractResult]) -> Either String ())
-> [(Text, [ContractResult])] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
            ( \(Text
a, [ContractResult]
cs) ->
                Bool -> String -> Either String ()
whenL
                    ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ((ContractResult -> Text) -> [ContractResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ContractResult -> Text
crCase [ContractResult]
cs)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [ContractResult] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ContractResult]
cs)
                    (String
"adapter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" reports a contract case twice")
            )
            [(Text, [ContractResult])]
byAdapter
        case [[Text]]
caseLists of
            [Text]
first : [[Text]]
rest ->
                Bool -> String -> Either String ()
whenL
                    (([Text] -> Bool) -> [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (([Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
first) ([Text] -> Bool) -> ([Text] -> [Text]) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort) [[Text]]
rest)
                    String
"the adapters do not report the same contract case list"
            [] -> () -> Either String ()
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

whenL :: Bool -> String -> Either String ()
whenL :: Bool -> String -> Either String ()
whenL Bool
True String
e = String -> Either String ()
forall a b. a -> Either a b
Left String
e
whenL Bool
False String
_ = () -> Either String ()
forall a b. b -> Either a b
Right ()

-- | Results grouped by adapter, adapters in first-reported order.
adapterCases :: [ContractResult] -> [(Text, [ContractResult])]
adapterCases :: [ContractResult] -> [(Text, [ContractResult])]
adapterCases [ContractResult]
cs =
    [ (Text
a, [ContractResult
c | ContractResult
c <- [ContractResult]
cs, ContractResult -> Text
crAdapter ContractResult
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a])
    | Text
a <- [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ((ContractResult -> Text) -> [ContractResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ContractResult -> Text
crAdapter [ContractResult]
cs)
    ]

-- * Layout

data Section = Section
    { Section -> Int
secLevel :: Int
    , Section -> Text
secTitle :: Text
    , Section -> [Text]
secBody :: [Text]
    , Section -> [Text]
secSpeech :: [Text]
    }

layout :: Text -> [Row] -> Snapshot -> RenderedPage
layout :: Text -> [Row] -> Snapshot -> RenderedPage
layout Text
model [Row]
rows Snapshot
snap =
    RenderedPage
        { renderedPage :: Text
renderedPage = [Text] -> Text
T.unlines ([Text]
preamble [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Section -> [Text]) -> [Section] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section -> [Text]
sectionText [Section]
sections)
        , renderedSpeech :: ByteString
renderedSpeech =
            Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> ([Pair] -> Value) -> [Pair] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object ([Pair] -> ByteString) -> [Pair] -> ByteString
forall a b. (a -> b) -> a -> b
$
                [ Text -> Key
Key.fromText (Text -> Text
slug (Section -> Text
secTitle Section
s))
                    Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text -> Value) -> [Text] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Value
segment (Section -> [Text]
secSpeech Section
s)
                | Section
s <- [Section]
sections
                ]
        }
  where
    base :: Text
base = Snapshot -> Text
snapBase Snapshot
snap
    shown :: [(Row, ShownState)]
shown =
        [ (Row
r, Text -> [Receipt] -> Row -> ShownState
effectiveState Text
base (Snapshot -> [Receipt]
snapReceipts Snapshot
snap) Row
r)
        | Row
r <- (Row -> Text) -> [Row] -> [Row]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Row -> Text
rowId [Row]
rows
        ]
    inState :: (ShownState -> Bool) -> [Row]
inState ShownState -> Bool
p = [Row
r | (Row
r, ShownState
s) <- [(Row, ShownState)]
shown, ShownState -> Bool
p ShownState
s]
    executed :: [Row]
executed = (ShownState -> Bool) -> [Row]
inState (ShownState -> ShownState -> Bool
forall a. Eq a => a -> a -> Bool
== ShownState
ShownExecuted)
    partial :: [Row]
partial = (ShownState -> Bool) -> [Row]
inState (ShownState -> ShownState -> Bool
forall a. Eq a => a -> a -> Bool
== ShownState
ShownPartial)
    recorded :: [(Row, Verdict)]
recorded = [(Row
r, Verdict
v) | (Row
r, ShownRecorded Verdict
v) <- [(Row, ShownState)]
shown]
    planned :: RowState -> [Row]
planned RowState
st = (ShownState -> Bool) -> [Row]
inState (ShownState -> ShownState -> Bool
forall a. Eq a => a -> a -> Bool
== RowState -> ShownState
ShownPlanned RowState
st)
    uncovered :: [Row]
uncovered = RowState -> [Row]
planned RowState
Uncovered
    elsewhere :: [Row]
elsewhere = RowState -> [Row]
planned RowState
BoundElsewhere
    outOfScope :: [Row]
outOfScope = RowState -> [Row]
planned RowState
OutOfScope
    adapters :: [(Text, [ContractResult])]
adapters = [ContractResult] -> [(Text, [ContractResult])]
adapterCases (Snapshot -> [ContractResult]
snapContract Snapshot
snap)
    count :: [a] -> Text
count = String -> Text
T.pack (String -> Text) -> ([a] -> String) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([a] -> Int) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

    preamble :: [Text]
preamble =
        [ Text
"# Conformance evidence"
        , Text
""
        , Text
"As an integrator deciding whether to build on Singular, I read which of the \
          \consumer requirements a run of one named code revision demonstrated, which \
          \it did not, and how every backend adapter answered the shared contract — \
          \and I can check that nothing on this page was typed by hand."
        , Text
""
        , Text
"This page is generated by `conformance evidence-page` from the requirement \
          \inventory `conformance/rows.json`, the application model revision in \
          \`conformance/model-revision`, and the receipts and contract results the CI \
          \runs named in the appendix produced for the code revision below. The \
          \documentation check regenerates it from those committed files and fails on \
          \any difference."
        , Text
""
        , Text
"The runs below are a historical snapshot of the broader registry law at \
          \their recorded code revision. They certify that revision only. To assess \
          \current two-edge coverage, read `conformance list` with receipts from the \
          \current revision. A separate supported retirement story cannot certify \
          \the original successful Absent, deletion or reincarnation requirements."
        , Text
""
        ]

    sections :: [Section]
sections =
        [ Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
2
            Text
"Permanent registration and termination"
            [ Text
"This bounded story targets the new permanent contract. Its evidence state is computed with the inventory below; historical broader receipts do not execute it. Exported script evaluation and the packaged ordinary CLI journey remain separate boundaries. The new release abandons earlier deployed registries; protected rejection follows this carve before the first milestone can close."
            , Text
""
            , String -> Text
T.pack String
Permanent.description
            ]
            [ Text
"A new permanent registry supports registration and permanent termination only. The story compares both allowed operations and refusals of all five excluded operations, including a mixed batch. Its current live conformance evidence state is read from receipts, never assigned from component tests."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
2
            Text
"What this evidence is bound to"
            [ Text
"| | |"
            , Text
"| --- | --- |"
            , Text
"| Code revision the runs checked out | `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` |"
            , Text
"| Application model revision | `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
model Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` |"
            , Text
"| Requirements in the inventory | "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
rows
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
outOfScope
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of scope) |"
            , Text
"| Demonstrated by a run | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
executed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            , Text
"| Partly demonstrated by a run | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
partial Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            , Text
"| Run, result not a pass | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Row, Verdict)] -> Text
forall {a}. [a] -> Text
count [(Row, Verdict)]
recorded Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            , Text
"| Bound to evidence elsewhere | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
elsewhere Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            , Text
"| Uncovered | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
uncovered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            , Text
"| Backend adapters in the contract runs | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, [ContractResult])] -> Text
forall {a}. [a] -> Text
count [(Text, [ContractResult])]
adapters Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            , Text
""
            , Text
"```mermaid"
            , Text
"flowchart LR"
            , Text
"    inventory[\"requirement inventory\"] -->|plan per requirement| render[\"evidence-page renderer\"]"
            , Text
"    receipts[\"conformance run receipts\"] -->|executed or partial, same revision only| render"
            , Text
"    contract[\"contract suite results\"] -->|per adapter and case| render"
            , Text
"    model[\"model revision\"] -->|named| render"
            , Text
"    render -->|writes| page[\"this page\"]"
            , Text
"    render -->|recomputes| check[\"documentation check\"]"
            , Text
"    page -->|compared byte for byte| check"
            , Text
"```"
            ]
            [ Text
"The runs behind this page checked out code revision "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
12 Text
base
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", and the application model revision is "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
12 Text
model
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            , [Row] -> Text
forall {a}. [a] -> Text
count [Row]
rows
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" requirements are in the inventory. "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
executed
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" were demonstrated by a run, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
partial
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" partly, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Row, Verdict)] -> Text
forall {a}. [a] -> Text
count [(Row, Verdict)]
recorded
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ran without a pass, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
elsewhere
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are bound to evidence elsewhere, "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
uncovered
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are uncovered and "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
outOfScope
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are out of scope."
            , Text
"The diagram shows the page computed from the inventory, the receipts, \
              \the contract results and the model revision, and the documentation check \
              \recomputing it and comparing."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
2
            Text
"Requirements a run demonstrated"
            ( [(Row, Text)] -> [Text]
requirementTable
                ( [(Row
r, Text
"demonstrated") | Row
r <- [Row]
executed]
                    [(Row, Text)] -> [(Row, Text)] -> [(Row, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Row
r, Text
"partly demonstrated") | Row
r <- [Row]
partial]
                )
            )
            [ [Row] -> Text
forall {a}. [a] -> Text
count [Row]
executed
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" requirements were demonstrated and "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Row] -> Text
forall {a}. [a] -> Text
count [Row]
partial
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" partly demonstrated by a receipt for this code revision. Each row \
                   \gives the requirement and the outcome it expects."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
2
            Text
"Requirements a run did not pass"
            ([(Row, Text)] -> [Text]
requirementTable [(Row
r, Text -> Verdict -> Text
verdictText (Row -> Text
rowId Row
r) Verdict
v) | (Row
r, Verdict
v) <- [(Row, Verdict)]
recorded])
            [ [(Row, Verdict)] -> Text
forall {a}. [a] -> Text
count [(Row, Verdict)]
recorded
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" requirements ran on this code revision with a result that is not a \
                   \pass. They are listed with the reason the run recorded."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
2
            Text
"Requirements not demonstrated"
            [ Text
"Every requirement without a receipt for this code revision is listed with \
              \the plan the inventory declares for it."
            ]
            [ Text
"Every requirement without a receipt for this code revision is listed \
              \below, under the plan the inventory declares."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
3
            Text
"Uncovered"
            ([(Row, Text)] -> [Text]
requirementTable [(Row
r, Text
"uncovered") | Row
r <- [Row]
uncovered])
            [[Row] -> Text
forall {a}. [a] -> Text
count [Row]
uncovered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" requirements have no evidence yet."]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
3
            Text
"Bound to evidence elsewhere"
            ( [(Row, Text)] -> [Text]
requirementTable
                [ (Row
r, Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"bound elsewhere" (Text
"bound elsewhere: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Row -> Maybe Text
rowEvidence Row
r))
                | Row
r <- [Row]
elsewhere
                ]
            )
            [ [Row] -> Text
forall {a}. [a] -> Text
count [Row]
elsewhere
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" requirements are evidenced by another suite, named in each row."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
3
            Text
"Out of scope"
            ([(Row, Text)] -> [Text]
requirementTable [(Row
r, Text
"out of scope") | Row
r <- [Row]
outOfScope])
            [ [Row] -> Text
forall {a}. [a] -> Text
count [Row]
outOfScope
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" requirements belong to the consumer, are recorded here and never \
                   \claimed."
            ]
        , Int -> Text -> [Text] -> [Text] -> Section
Section
            Int
2
            Text
"Backend contract across adapters"
            ( [ Text
"One case list runs against every adapter. A case an adapter cannot \
                \exercise is reported for it as not supported, with the reason; it is \
                \never counted as passed."
              , Text
""
              , Text
"| Adapter | Evidence class | Passed | Failed | Not supported |"
              , Text
"| --- | --- | --- | --- | --- |"
              ]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"| "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ContractResult] -> Text
evidenceText [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
isPassed [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
isFailed [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
isNotSupported [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
                   | (Text
a, [ContractResult]
cs) <- [(Text, [ContractResult])]
adapters
                   ]
            )
            [ [(Text, [ContractResult])] -> Text
forall {a}. [a] -> Text
count [(Text, [ContractResult])]
adapters
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" adapters ran the contract suite. The table counts, per adapter, \
                   \the cases passed, failed and not supported."
            ]
        ]
            [Section] -> [Section] -> [Section]
forall a. Semigroup a => a -> a -> a
<> [ Int -> Text -> [Text] -> [Text] -> Section
Section
                    Int
3
                    (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" adapter")
                    ( [ Text
"Evidence class: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ContractResult] -> Text
evidenceText [ContractResult]
cs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                      , Text
""
                      , Text
"| Contract case | Kind | Result |"
                      , Text
"| --- | --- | --- |"
                      ]
                        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"| "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cell (ContractResult -> Text
crRequirement ContractResult
c)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ContractResult -> Text
crKind ContractResult
c
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cell (ContractOutcome -> Text
outcomeText (ContractResult -> ContractOutcome
crOutcome ContractResult
c))
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
                           | ContractResult
c <- [ContractResult]
cs
                           ]
                    )
                    [ Text
"The "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" adapter, evidence class "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ContractResult] -> Text
evidenceText [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
isPassed [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cases passed, "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
isFailed [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed and "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
isNotSupported [ContractResult]
cs
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are not supported."
                    ]
               | (Text
a, [ContractResult]
cs) <- [(Text, [ContractResult])]
adapters
               ]
            [Section] -> [Section] -> [Section]
forall a. Semigroup a => a -> a -> a
<> [ Int -> Text -> [Text] -> [Text] -> Section
Section
                    Int
2
                    Text
"Appendix: how this page was produced"
                    ( [ Text
"This appendix is harness evidence: where the files behind this \
                        \page came from. It says nothing more about the product."
                      , Text
""
                      , Text
"| Workflow | Run | Artifact |"
                      , Text
"| --- | --- | --- |"
                      ]
                        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"| "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Source -> Text
sourceWorkflow Source
s
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Source -> Text
sourceRun Source
s
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Source -> Text
sourceArtifact Source
s
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
                           | Source
s <- Snapshot -> [Source]
snapSources Snapshot
snap
                           ]
                        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
""
                           , Text
"The committed snapshot is `conformance/evidence/page/`: "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [String] -> Text
forall {a}. [a] -> Text
count (Snapshot -> [String]
snapReceiptFiles Snapshot
snap)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" files of the receipt artifacts under `receipts/`, of which "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Receipt] -> Text
forall {a}. [a] -> Text
count (Snapshot -> [Receipt]
snapReceipts Snapshot
snap)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are receipts, and "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [String] -> Text
forall {a}. [a] -> Text
count (Snapshot -> [String]
snapContractFiles Snapshot
snap)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" contract results files under `contract/` holding "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ContractResult] -> Text
forall {a}. [a] -> Text
count (Snapshot -> [ContractResult]
snapContract Snapshot
snap)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" results."
                           , Text
""
                           , Text
"Regenerate the page with `nix run ./conformance#conformance -- \
                             \evidence-page --write`; check it with the same command without \
                             \`--write`."
                           ]
                    )
                    [ Text
"This appendix names the CI runs and artifacts the snapshot was \
                      \copied from, and how many receipts and contract results it holds."
                    ]
               ]

    requirementTable :: [(Row, Text)] -> [Text]
requirementTable [(Row, Text)]
entries =
        if [(Row, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Row, Text)]
entries
            then [Text
"None."]
            else
                [ Text
"| Name | Requirement | Expected outcome | State |"
                , Text
"| --- | --- | --- | --- |"
                ]
                    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"| "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Row -> Text
rowId Row
r
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cell (Row -> Text
rowRequirement Row
r)
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cell (Row -> Text
rowExpected Row
r)
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cell Text
st
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
                       | (Row
r, Text
st) <- [(Row, Text)]
entries
                       ]

    evidenceText :: [ContractResult] -> Text
evidenceText [ContractResult]
cs =
        Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ContractResult -> Text) -> [ContractResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ContractEvidence -> Text
contractEvidenceName (ContractEvidence -> Text)
-> (ContractResult -> ContractEvidence) -> ContractResult -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractResult -> ContractEvidence
crEvidence) [ContractResult]
cs
    outcomes :: (ContractOutcome -> Bool) -> [ContractResult] -> Text
outcomes ContractOutcome -> Bool
p = [ContractResult] -> Text
forall {a}. [a] -> Text
count ([ContractResult] -> Text)
-> ([ContractResult] -> [ContractResult])
-> [ContractResult]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractResult -> Bool) -> [ContractResult] -> [ContractResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (ContractOutcome -> Bool
p (ContractOutcome -> Bool)
-> (ContractResult -> ContractOutcome) -> ContractResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractResult -> ContractOutcome
crOutcome)

segment :: Text -> Value
segment :: Text -> Value
segment Text
t = [Pair] -> Value
object [Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
t, Key
"pause" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
400 :: Int)]

sectionText :: Section -> [Text]
sectionText :: Section -> [Text]
sectionText Section
s =
    [Int -> Text -> Text
T.replicate (Section -> Int
secLevel Section
s) Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Section -> Text
secTitle Section
s, Text
""]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Section -> [Text]
secBody Section
s
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
""]

cell :: Text -> Text
cell :: Text -> Text
cell = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"|" Text
"\\|" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\n" Text
" "

contractEvidenceName :: ContractEvidence -> Text
contractEvidenceName :: ContractEvidence -> Text
contractEvidenceName ContractEvidence
ContractTestAdapter = Text
"test-adapter"
contractEvidenceName ContractEvidence
ContractDevNet = Text
"devnet"

outcomeText :: ContractOutcome -> Text
outcomeText :: ContractOutcome -> Text
outcomeText = \case
    ContractOutcome
ContractPassed -> Text
"passed"
    ContractFailed Text
r -> Text
"failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r
    ContractNotSupported Text
r -> Text
"not supported: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r

isPassed, isFailed, isNotSupported :: ContractOutcome -> Bool
isPassed :: ContractOutcome -> Bool
isPassed ContractOutcome
ContractPassed = Bool
True
isPassed ContractOutcome
_ = Bool
False
isFailed :: ContractOutcome -> Bool
isFailed ContractFailed{} = Bool
True
isFailed ContractOutcome
_ = Bool
False
isNotSupported :: ContractOutcome -> Bool
isNotSupported ContractNotSupported{} = Bool
True
isNotSupported ContractOutcome
_ = Bool
False

verdictText :: Text -> Verdict -> Text
verdictText :: Text -> Verdict -> Text
verdictText Text
row = \case
    Verdict
AgreesWithModel -> Text
"agrees with the model"
    Verdict
HeldQ002 ->
        Text
"held: the chain sided with Singular's model against the consumer's \
        \theorem, pending a ruling"
    Verdict
DivergesFromLean -> Text
"diverges: the chain contradicts Singular's model"
    Verdict
ResolvedByRuling -> Text
"resolved by a ruling: retained as history, not a pass"
    Verdict
UnmetByRuling -> Text -> (UnmetRuling -> Text) -> Maybe UnmetRuling -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"unmet by a ruling" UnmetRuling -> Text
unmetReading (Text -> Maybe UnmetRuling
unmetRuling Text
row)
    Verdict
Partial -> Text
"partial"

-- | python-markdown's table-of-contents id, as MkDocs renders it.
slug :: Text -> Text
slug :: Text -> Text
slug =
    (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"-"
        ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
        (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isWordChar Char
c)
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
  where
    isWordChar :: Char -> Bool
isWordChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

-- * The command

{- | Render the published evidence page from the repository at @root@:
@conformance/rows.json@, @conformance/model-revision@ and the snapshot
@conformance/evidence/page@. With @write@ the page and its (unstamped)
speech companion are written. Otherwise the committed page must equal
the rendering byte for byte and the committed speech must carry exactly
the rendered sections, or the command exits non-zero naming the
disagreement.
-}
runEvidencePage :: FilePath -> Bool -> IO ()
runEvidencePage :: String -> Bool -> IO ()
runEvidencePage String
root Bool
write = do
    rows <-
        String -> IO (Either String [Row])
loadRows (String
root String -> ShowS
</> String
"conformance/rows.json") IO (Either String [Row])
-> (Either String [Row] -> IO [Row]) -> IO [Row]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO [Row])
-> ([Row] -> IO [Row]) -> Either String [Row] -> IO [Row]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO [Row]
forall a. String -> IO a
refuse [Row] -> IO [Row]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    model <-
        T.strip <$> TIO.readFile (root </> "conformance/model-revision")
    snap <-
        loadSnapshot (root </> "conformance/evidence/page")
            >>= either refuse pure
    page <- either refuse pure (renderEvidencePage model rows snap)
    if write
        then do
            TIO.writeFile pagePath (renderedPage page)
            BSL.writeFile speechPath (renderedSpeech page)
            putStrLn ("wrote " <> pagePath <> " and " <> speechPath)
        else do
            exists <- doesFileExist pagePath
            unless exists (refuse (pagePath <> " is missing"))
            committed <- TIO.readFile pagePath
            case firstDifference (T.lines (renderedPage page)) (T.lines committed) of
                Just (Int
n, Text
want, Text
got) ->
                    String -> IO ()
forall a. String -> IO a
refuse
                        ( String
pagePath
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" disagrees with the receipts it is computed from at line "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": rendered "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
want
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", published "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
got
                        )
                Maybe (Int, Text, Text)
Nothing
                    | Text
committed Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= RenderedPage -> Text
renderedPage RenderedPage
page ->
                        String -> IO ()
forall a. String -> IO a
refuse (String
pagePath String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" differs from its rendering in line endings")
                    | Bool
otherwise -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            speech <- eitherDecode <$> BSL.readFile speechPath
            case (speech, eitherDecode (renderedSpeech page)) of
                (Right (Object KeyMap Value
o), Right (Object KeyMap Value
r))
                    | (Key -> Value -> Bool) -> KeyMap Value -> KeyMap Value
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KeyMap.filterWithKey (\Key
k Value
_ -> Bool -> Bool
not (Text -> Text -> Bool
T.isPrefixOf Text
"_" (Key -> Text
Key.toText Key
k))) KeyMap Value
o
                        KeyMap Value -> KeyMap Value -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMap Value
r ->
                        String -> IO ()
putStrLn
                            ( String
pagePath
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" equals its rendering from the receipts of "
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Snapshot -> Text
snapBase Snapshot
snap)
                            )
                (Either String Value, Either String Value)
_ ->
                    String -> IO ()
forall a. String -> IO a
refuse
                        (String
speechPath String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" disagrees with the rendered page's sections")
  where
    pagePath :: String
pagePath = String
root String -> ShowS
</> String
"docs/conformance-evidence.md"
    speechPath :: String
speechPath = String
root String -> ShowS
</> String
"docs/conformance-evidence.speech.json"

refuse :: String -> IO a
refuse :: forall a. String -> IO a
refuse String
msg = do
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"conformance evidence-page: FAILED: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg)
    IO a
forall a. IO a
exitFailure

-- | The first line (1-based) where two texts differ, with both sides.
firstDifference :: [Text] -> [Text] -> Maybe (Int, Text, Text)
firstDifference :: [Text] -> [Text] -> Maybe (Int, Text, Text)
firstDifference [Text]
want [Text]
got =
    case [ (Int
n, Text
w, Text
g)
         | (Int
n, Text
w, Text
g) <-
            [Int] -> [Text] -> [Text] -> [(Int, Text, Text)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3
                [Int
1 ..]
                ([Text] -> [Text]
forall {a}. IsString a => [a] -> [a]
pad [Text]
want)
                ([Text] -> [Text]
forall {a}. IsString a => [a] -> [a]
pad [Text]
got)
         , Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
g
         ] of
        (Int
n, Text
w, Text
g) : [(Int, Text, Text)]
_ -> (Int, Text, Text) -> Maybe (Int, Text, Text)
forall a. a -> Maybe a
Just (Int
n, Text
w, Text
g)
        [] -> Maybe (Int, Text, Text)
forall a. Maybe a
Nothing
  where
    width :: Int
width = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
want) ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
got)
    pad :: [a] -> [a]
pad [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
width ([a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> a -> [a]
forall a. a -> [a]
repeat a
"<end of page>")