{-# LANGUAGE OverloadedStrings #-}

-- | The halt-mark grammar as a type.
--
-- Marks are the bus's boundary vocabulary: a finite set of glyphs that
-- prefix a post body and announce the post's role in an exchange. This is
-- the level-0 grammar of the quiescence thread — the free boundary
-- @K + payload@ with @K@ finite, the stateless 'isMark' of the mark
-- machine (@spinMark@). Anything stateful (round counters, roles) lives
-- above this layer.
--
-- The glyphs:
--
--   * 🟡 'Motion' — a claim: "I pick this up".
--   * ✓ 'Consent' — no objection.
--   * ↩ 'Amendment' — an amendment offered.
--   * 🔴 'Escalate' — "I can't move this"; the human's door.
--   * 🟢 'Landed' — halt: the claim landed.
--   * 🔵 'StandDown' — halt: standing down. Also the quiescence mark:
--     a runner that judges observed quiet posts this to convert its
--     judgment into decided quiet for everyone downstream.
--
-- History note: the quiescence marker was previously posted under 🟡,
-- colliding with 'Motion'. Legacy bodies like @"🟡 quiescent after N
-- empty cycles"@ parse as 'Motion' under this grammar — that ambiguity is
-- exactly why quiescence moved to 🔵. Do not reintroduce it.
--
-- Design card: @coffee\/loom\/board.md@ ("what the halt-mark grammar is").
module Circuit.Agent.Mark
  ( Mark (..),
    markGlyph,
    parseMark,
    markOf,
    isHalt,
    isEscalate,
  )
where

import Circuit.Agent (Post (..))
import Data.Text (Text)
import Data.Text qualified as T

-- | A boundary mark.
data Mark
  = -- | 🟡 claim: "I pick this up".
    Motion
  | -- | ✓ no objection.
    Consent
  | -- | ↩ amendment offered.
    Amendment
  | -- | 🔴 escalation: "I can't move this".
    Escalate
  | -- | 🟢 halt: landed.
    Landed
  | -- | 🔵 halt: standing down / quiescent.
    StandDown
  deriving (Mark -> Mark -> Bool
(Mark -> Mark -> Bool) -> (Mark -> Mark -> Bool) -> Eq Mark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mark -> Mark -> Bool
== :: Mark -> Mark -> Bool
$c/= :: Mark -> Mark -> Bool
/= :: Mark -> Mark -> Bool
Eq, Eq Mark
Eq Mark =>
(Mark -> Mark -> Ordering)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Mark)
-> (Mark -> Mark -> Mark)
-> Ord Mark
Mark -> Mark -> Bool
Mark -> Mark -> Ordering
Mark -> Mark -> Mark
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 :: Mark -> Mark -> Ordering
compare :: Mark -> Mark -> Ordering
$c< :: Mark -> Mark -> Bool
< :: Mark -> Mark -> Bool
$c<= :: Mark -> Mark -> Bool
<= :: Mark -> Mark -> Bool
$c> :: Mark -> Mark -> Bool
> :: Mark -> Mark -> Bool
$c>= :: Mark -> Mark -> Bool
>= :: Mark -> Mark -> Bool
$cmax :: Mark -> Mark -> Mark
max :: Mark -> Mark -> Mark
$cmin :: Mark -> Mark -> Mark
min :: Mark -> Mark -> Mark
Ord, Int -> Mark -> ShowS
[Mark] -> ShowS
Mark -> String
(Int -> Mark -> ShowS)
-> (Mark -> String) -> ([Mark] -> ShowS) -> Show Mark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mark -> ShowS
showsPrec :: Int -> Mark -> ShowS
$cshow :: Mark -> String
show :: Mark -> String
$cshowList :: [Mark] -> ShowS
showList :: [Mark] -> ShowS
Show, Int -> Mark
Mark -> Int
Mark -> [Mark]
Mark -> Mark
Mark -> Mark -> [Mark]
Mark -> Mark -> Mark -> [Mark]
(Mark -> Mark)
-> (Mark -> Mark)
-> (Int -> Mark)
-> (Mark -> Int)
-> (Mark -> [Mark])
-> (Mark -> Mark -> [Mark])
-> (Mark -> Mark -> [Mark])
-> (Mark -> Mark -> Mark -> [Mark])
-> Enum Mark
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Mark -> Mark
succ :: Mark -> Mark
$cpred :: Mark -> Mark
pred :: Mark -> Mark
$ctoEnum :: Int -> Mark
toEnum :: Int -> Mark
$cfromEnum :: Mark -> Int
fromEnum :: Mark -> Int
$cenumFrom :: Mark -> [Mark]
enumFrom :: Mark -> [Mark]
$cenumFromThen :: Mark -> Mark -> [Mark]
enumFromThen :: Mark -> Mark -> [Mark]
$cenumFromTo :: Mark -> Mark -> [Mark]
enumFromTo :: Mark -> Mark -> [Mark]
$cenumFromThenTo :: Mark -> Mark -> Mark -> [Mark]
enumFromThenTo :: Mark -> Mark -> Mark -> [Mark]
Enum, Mark
Mark -> Mark -> Bounded Mark
forall a. a -> a -> Bounded a
$cminBound :: Mark
minBound :: Mark
$cmaxBound :: Mark
maxBound :: Mark
Bounded)

-- | The glyph that renders a mark.
markGlyph :: Mark -> Text
markGlyph :: Mark -> Text
markGlyph = \case
  Mark
Motion -> Text
"\x1F7E1" -- 🟡
  Mark
Consent -> Text
"\x2713" -- ✓
  Mark
Amendment -> Text
"\x21A9" -- ↩
  Mark
Escalate -> Text
"\x1F534" -- 🔴
  Mark
Landed -> Text
"\x1F7E2" -- 🟢
  Mark
StandDown -> Text
"\x1F535" -- 🔵

-- | Parse a mark from the start of a body. Tolerates the emoji variation
-- selector (U+FE0F) between glyph and rest. Exact glyphs only — no fuzzy
-- matching, so a body that merely talks about marks is not one.
parseMark :: Text -> Maybe Mark
parseMark :: Text -> Maybe Mark
parseMark Text
t = [Mark] -> Maybe Mark
go [Mark
forall a. Bounded a => a
minBound .. Mark
forall a. Bounded a => a
maxBound]
  where
    go :: [Mark] -> Maybe Mark
go [] = Maybe Mark
forall a. Maybe a
Nothing
    go (Mark
m : [Mark]
ms)
      | Text
glyph Text -> Text -> Bool
`T.isPrefixOf` Text
t = Mark -> Maybe Mark
forall a. a -> Maybe a
Just Mark
m
      | (Text
glyph Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\xFE0F") Text -> Text -> Bool
`T.isPrefixOf` Text
t = Mark -> Maybe Mark
forall a. a -> Maybe a
Just Mark
m
      | Bool
otherwise = [Mark] -> Maybe Mark
go [Mark]
ms
      where
        glyph :: Text
glyph = Mark -> Text
markGlyph Mark
m

-- | The mark carried by a post's body, if any.
markOf :: Post Text -> Maybe Mark
markOf :: Post Text -> Maybe Mark
markOf = Text -> Maybe Mark
parseMark (Text -> Maybe Mark)
-> (Post Text -> Text) -> Post Text -> Maybe Mark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post Text -> Text
forall a. Post a -> a
body

-- | Halt marks: the exchange is over. 'Landed' and 'StandDown'.
isHalt :: Mark -> Bool
isHalt :: Mark -> Bool
isHalt = \case
  Mark
Landed -> Bool
True
  Mark
StandDown -> Bool
True
  Mark
_ -> Bool
False

-- | Escalation: leave the loop, wake the human.
isEscalate :: Mark -> Bool
isEscalate :: Mark -> Bool
isEscalate = (Mark -> Mark -> Bool
forall a. Eq a => a -> a -> Bool
== Mark
Escalate)