packages feed

baikai-kit-0.3.0.0: src/Baikai/Kit/Json.hs

-- | The machine-readable documents @kit list --json@, @kit status --json@
--   and @kit update --json@ print, as explicit encoders.
--
--   These shapes are a public, versioned contract, pinned by golden tests
--   in @baikai-kit/test/golden/@. They are written here by hand rather
--   than derived, so renaming a Haskell field cannot change them. Every
--   document carries 'kitJsonFormatVersion' and a @document@ name. Adding
--   a key keeps the version; removing or renaming one, or changing what a
--   value means, increments it. Every documented key is always present,
--   with @null@ for an absent value.
--
--   See @docs/adr/0024-machine-readable-kit-output-is-a-versioned-contract.md@.
module Baikai.Kit.Json
  ( kitJsonFormatVersion,
    listDocument,
    statusDocument,
    updateDocument,
  )
where

import Baikai.Kit.Config (KitScope, providerLabel, scopeLabel)
import Baikai.Kit.Error (renderKitError)
import Baikai.Kit.Install (UpdateReport)
import Baikai.Kit.Manifest (KitItemKind (..), KitManifest, kindLabel)
import Baikai.Kit.Repo (RepoRefresh (..))
import Baikai.Kit.Status
  ( InstalledCopy,
    StatusReport,
    StatusRow,
    UpstreamAvailability (..),
    conditionLabel,
  )
import Baikai.Prelude hiding ((.=))
import Data.Aeson (Value (Null), object, (.=))
import Data.List (sortOn)

-- | The @formatVersion@ every document carries.
kitJsonFormatVersion :: Int
kitJsonFormatVersion = 1

-- | @kit-list@: what the kit offers, skills then agents in manifest order,
--   each with the copies installed of it (sorted user before project,
--   then by provider).
listDocument :: UpstreamAvailability -> KitManifest -> [InstalledCopy] -> Value
listDocument availability manifest copies =
  object
    [ "formatVersion" .= kitJsonFormatVersion,
      "document" .= ("kit-list" :: Text),
      "upstream" .= upstreamValue availability,
      "items"
        .= ( [ itemValue SkillKind (entry ^. #name) (entry ^. #description) (entry ^. #version)
             | entry <- manifest ^. #skills
             ]
               ++ [ itemValue AgentKind (entry ^. #name) (entry ^. #description) (entry ^. #version)
                  | entry <- manifest ^. #agents
                  ]
           )
    ]
  where
    itemValue :: KitItemKind -> Text -> Text -> Maybe Text -> Value
    itemValue kind n description version =
      object
        [ "name" .= n,
          "kind" .= kindLabel kind,
          "description" .= description,
          "version" .= version,
          "installed"
            .= map
              copyValue
              ( sortOn
                  (\copy -> (copy ^. #scope, providerLabel (copy ^. #provider)))
                  [copy | copy <- copies, copy ^. #name == n, copy ^. #kind == kind]
              )
        ]
    copyValue :: InstalledCopy -> Value
    copyValue copy =
      object
        [ "scope" .= scopeLabel (copy ^. #scope),
          "provider" .= providerLabel (copy ^. #provider),
          "version" .= (copy ^. #version),
          "path" .= (copy ^. #path)
        ]

-- | @kit-status@: one entry per installed copy — item, scope, and
--   provider — never aggregated, sorted by name, kind, scope, provider.
statusDocument :: StatusReport -> Value
statusDocument report =
  object
    [ "formatVersion" .= kitJsonFormatVersion,
      "document" .= ("kit-status" :: Text),
      "upstream" .= upstreamValue (report ^. #upstream),
      "items" .= map rowValue (sortOn rowKey (report ^. #rows))
    ]
  where
    rowKey row = (row ^. #name, row ^. #kind, row ^. #scope, row ^. #providers)
    rowValue :: StatusRow -> Value
    rowValue row =
      object
        [ "name" .= (row ^. #name),
          "kind" .= (row ^. #kind),
          "scope" .= (row ^. #scope),
          "provider" .= (row ^. #providers),
          "installedVersion" .= (row ^. #installedVersion),
          "latestVersion" .= (row ^. #latestVersion),
          "conditions" .= map conditionLabel (row ^. #conditions),
          "upToDate" .= null (row ^. #conditions)
        ]

-- | @kit-update@: how the cache was refreshed and what was updated or
--   skipped, in the report's order.
updateDocument :: UpdateReport -> Value
updateDocument report =
  object
    [ "formatVersion" .= kitJsonFormatVersion,
      "document" .= ("kit-update" :: Text),
      "refresh" .= fmap refreshLabel (report ^. #refresh),
      "updated" .= map updatedValue (report ^. #updated),
      "skipped" .= map skippedValue (report ^. #skipped)
    ]
  where
    refreshLabel :: RepoRefresh -> Text
    refreshLabel = \case
      RepoCloned -> "cloned"
      RepoPulled -> "pulled"
      RepoStale _ -> "stale"
    updatedValue :: (Text, KitScope) -> Value
    updatedValue (n, scope) = object ["name" .= n, "scope" .= scopeLabel scope]
    -- 'UpdateReport' skips an item only for local edits today; the reason
    -- is spelled out so a later reason is an added value, not a new key.
    skippedValue :: (Text, KitScope) -> Value
    skippedValue (n, scope) =
      object
        [ "name" .= n,
          "scope" .= scopeLabel scope,
          "reason" .= ("locally-modified" :: Text)
        ]

upstreamValue :: UpstreamAvailability -> Value
upstreamValue = \case
  UpstreamReady -> object ["state" .= ("ready" :: Text), "detail" .= Null]
  UpstreamStale detail -> object ["state" .= ("stale" :: Text), "detail" .= detail]
  UpstreamUnavailable err -> object ["state" .= ("unavailable" :: Text), "detail" .= renderKitError err]