Arbitraries.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{- |
Module      : HStratus.Notes.Arbitraries
Copyright   : (c) 2026 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD-3-Clause

Orphan 'Arbitrary' instances for proto and domain types used in property tests.
Import this module to bring the instances into scope; nothing else is exported.
-}
module HStratus.Notes.Arbitraries () where

import qualified Data.Text as T
import Network.HStratus.Internal.Notes.Note
  ( NoteRun (..)
  , NoteStyle (..)
  , NoteText (..)
  )
import Network.HStratus.Internal.Notes.Proto (ProtoParagraphStyle (..))
import Test.QuickCheck


{- | Generates 'ProtoParagraphStyle' values that survive a proto3 encode/decode
roundtrip.  Two constraints apply:

  * 'ppsListStart' is 'Nothing' or 'Just n' with n >= 1, because proto3
    cannot distinguish an absent int32 from a zero int32 on the wire.

  * 'ppsChecked' is 'Just _' only when 'ppsStyleType' == 103 (checklist),
    mirroring what 'parseParagraphStyle' produces for real notes.
-}
instance Arbitrary ProtoParagraphStyle where
  arbitrary = do
    ppsStyleType <- elements [0, 1, 2, 4, 100, 101, 102, 103]
    ppsIndent <- choose (0, 4)
    ppsChecked <- case ppsStyleType of
      103 -> Just <$> arbitrary
      _ -> pure Nothing
    ppsListStart <- case ppsStyleType of
      102 -> oneof [pure Nothing, Just <$> choose (1, 9)]
      _ -> pure Nothing
    ppsBlockQuote <- case ppsStyleType of
      0 -> arbitrary
      _ -> pure False
    pure ProtoParagraphStyle{ppsStyleType, ppsIndent, ppsChecked, ppsListStart, ppsBlockQuote}


{- | Generates 'NoteStyle' values that are in the image of 'toNoteStyle'.
'StyleBody False' is excluded: 'toNoteStyle' maps both style_type=0 with
block_quote=False and style_type=0 with block_quote absent to 'StyleTitle',
never to 'StyleBody False'.
-}
instance Arbitrary NoteStyle where
  arbitrary =
    oneof
      [ pure StyleTitle
      , pure StyleHeading
      , pure StyleSubheading
      , pure StyleMonospaced
      , pure (StyleBody True)
      , StyleBullet <$> choose (0, 4)
      , StyleDash <$> choose (0, 4)
      , StyleNumbered <$> choose (0, 4) <*> oneof [pure Nothing, Just <$> choose (1, 9)]
      , StyleChecklist <$> choose (0, 4) <*> arbitrary
      ]


{- | Generates 'NoteRun' values.  'nrLength' is kept in [1, 20] to bound the
total text length generated by 'Arbitrary NoteText'.  'nrLink' is always
'Nothing' (deferred; encoding links requires additional TestHelper support).
-}
instance Arbitrary NoteRun where
  arbitrary =
    NoteRun
      <$> choose (1, 20)
      <*> arbitrary
      <*> arbitrary
      <*> arbitrary
      <*> arbitrary
      <*> arbitrary
      <*> pure Nothing -- nrAttachmentId (deferred)
      <*> pure Nothing -- nrLink (deferred)


{- | Generates 'NoteText' values whose 'ntText' length equals the sum of all
'nrLength' fields.  Runs are generated first; the text is filled with
lowercase ASCII to match the exact character count.
-}
instance Arbitrary NoteText where
  arbitrary = do
    runs <- listOf arbitrary
    let totalLen = fromIntegral (sum (map nrLength runs)) :: Int
    chars <- vectorOf totalLen (elements ['a' .. 'z'])
    pure NoteText{ntText = T.pack chars, ntRuns = runs}