Comonad

  ____ ___  __  __  ___  _   _    _    ____  ____
 / ___/ _ \|  \/  |/ _ \| \ | |  / \  |  _ \/ ___|
| |  | | | | |\/| | | | |  \| | / _ \ | | | \___ \
| |__| |_| | |  | | |_| | |\  |/ ___ \| |_| |___) |
 \____\___/|_|  |_|\___/|_| \_/_/   \_\____/|____/

We need to put the universe back in balance. By introducing many conceptual structures, we forgot the very basics:

For every action, there is an equal and opposite reaction.^[1]

In category theory, this manifests as categorical duality: for every structure we build, there exists a natural "opposite" that reveals hidden symmetries and unlocks new computational patterns.

We've learned about functors that map forward, but what about functors that map backward? We've mastered applicatives that combine values, but what about structures that split them apart? We've embraced monads that wrap contexts around values, but what about structures that extract values from their contexts?

The Principle of Categorical Duality #

In category theory, every construction has a dual obtained by reversing all the arrows.

Consider any categorical diagram:

A --- f ---> B --- g --> C

Its dual reverses every arrow:

A <--- f^op --- B <-- g^op --- C

Looks familiar? We touched upon this in codomains and coproducts. Duality is baked into the structures themselves.

1. Symmetry Principle^[2]: The symmetries of the causes are to be found in the effects
2. Computational Completeness: Forward operations need backward operations for full expressiveness
3. Structural Completeness: Categorical duality ensures that for every way to build structure, there exists a corresponding way to analyze or decompose it, providing complete bidirectional computational expressiveness.

If you can compose functions, you should also be able to decompose them. If you can combine values, you should also be able to separate them. Category theory makes this intuition precise.

Every abstraction we've learned sits on a spectrum with its dual:

Forward Direction	Backward Direction
map(f)	contramap(f)
combine	divide
wrap context	extract from context

Every time you write a comparison function, use form validation, or render UI components, you're leveraging these dualities whether you know it or not.

The Complete Duality Landscape #

By tradition, understanding every new fundamental concept starts with a category. Luckily for us, we have already learned about opposite categories. We'll start with a quick refresher on functors.

Functor - Contravariant Functor #

A contravariant functor F from category C to category D is a functor from C^op to D. Equivalently:

• Object mapping: F: Ob(C) → Ob(D)
• Morphism mapping: For f: A → B in C, we get F(f): F(B) → F(A) in D
• Arrow reversal: The direction of morphisms is reversed

Contravariant Functor Laws:

• Identity preservation: F(id_A) = id_{F(A)}
• Composition reversal: F(g ∘ f) = F(f) ∘ F(g)

Composition order is reversed compared to regular (covariant) functors.

The contramap Operation:

class Contravariant f where
  contramap :: (a -> b) -> f b -> f a
  --        ↑ input function direction
  --                    ↑ result direction (reversed!)

Example 1 - Predicate (Boolean Functions):

import Data.Functor.Contravariant (Contravariant (contramap))

-- Predicate is contravariant in its input type
newtype Predicate a = Predicate
  { runPredicate :: a -> Bool
  }

instance Contravariant Predicate where
  contramap f (Predicate p) = Predicate (p . f)
  --        ↑ preprocess input before applying predicate

-- Usage
isEven :: Predicate Int
isEven = Predicate even

-- Contramap allows us to reuse predicates
isEvenLength :: Predicate String
isEvenLength = contramap length isEven
-- length :: String -> Int (forward)
-- contramap makes it work on Strings

matching :: Predicate a -> [a] -> [a]
matching predicate = filter (runPredicate predicate)

main :: IO ()
main = do
  putStrLn "Test the original Predicate Int:"
  print $ runPredicate isEven 4
  print $ runPredicate isEven 7

  putStrLn "\nReuse it as a Predicate String with contramap:"
  print $ runPredicate isEvenLength "Haskell"
  print $ runPredicate isEvenLength "code"

  putStrLn "\nFilter values with both predicates:"
  print $ matching isEven [1 .. 10]
  print $ matching isEvenLength ["a", "to", "cat", "code", "lambda"]

Example 2 - Comparison Functions:

import Data.Functor.Contravariant (Contravariant (contramap))

-- Comparison is contravariant in both arguments
newtype Comparison a = Comparison (a -> a -> Ordering)

runComparison :: Comparison a -> a -> a -> Ordering
runComparison (Comparison cmp) = cmp

instance Contravariant Comparison where
  contramap f (Comparison cmp) = Comparison (\x y -> cmp (f x) (f y))

-- Usage
intCompare :: Comparison Int
intCompare = Comparison compare

-- Reuse for any type that has a length
lengthCompare :: Comparison String
lengthCompare = contramap length intCompare

main :: IO ()
main = do
  print $ runComparison intCompare 10 20
  print $ runComparison lengthCompare "cat" "elephant"
  print $ runComparison lengthCompare "same" "size"

Example 3 - Serializers/Encoders:

interface Encoder<A> {
  encode: (value: A) => string
}

// Contravariant in the input type A
const contramap = <A, B>(f: (b: B) => A) =>
  (encoder: Encoder<A>): Encoder<B> => ({
    encode: (b: B) => encoder.encode(f(b))
  })

// Usage
const intEncoder: Encoder<number> = {
  encode: (n) => n.toString()
}

// Reuse for any type that can become a number
const lengthEncoder: Encoder<string> =
  contramap((s: string) => s.length)(intEncoder)

console.log(lengthEncoder.encode("1234567890"))

Visually:

Regular Functor (Covariant):
Input  -- f --> Output    (data flows forward)
F(In) -------> F(Out)    (functor preserves direction)

Contravariant Functor:
Input  --f---> Output    (data still flows forward)
F(In) <------- F(Out)    (contramap reverses type flow)

Why Arrow Reversal:

• Consumers vs Producers: Functors typically transform producers of data
• Contravariant functors transform consumers of data
• Input requirements flow backward: If you need a String consumer, you can use an Int consumer + a preprocessing function

Contravariant functors appear in:

• Predicates (testing functions)
• Comparisons (sorting functions)
• Serializers (output formatting)
• Event handlers (input processing)

They represent the dual of regular functors, providing the "backward" transformation capability that completes the computational cycle.

Applicative - Divisible #

A Divisible functor is the contravariant dual of Applicative. Where Applicative combines independent computations, Divisible splits a single input into multiple independent paths.

Given a contravariant functor f, Divisible f provides:

• conquer: A "trivial" computation that ignores its input
• divide: Split one input into two independent computations

Divisible Laws:

class Contravariant f => Divisible f where
  conquer :: f a
  divide :: (a -> (b, c)) -> f b -> f c -> f a

Laws:

1. Left Identity: divide (λx -> (x, x)) conquer m ≡ m
2. Right Identity: divide (λx -> (x, x)) m conquer ≡ m
3. Associativity: divide operations can be regrouped without changing semantics

Combining vs Splitting:

Applicative construction:
f a + f b -- liftA2 (,) --> f (a, b)

Divisible construction:
(a -> (b, c)) + f b + f c -- divide --> f a

Runtime flow through the resulting consumer:
a -- split --> (b, c)
b -- consumed by --> f b
c -- consumed by --> f c

Example 1 - Form Validation:

import Data.Functor.Contravariant (Contravariant (contramap))

-- Contravariant equivalent of Applicative: divide the input between two
-- consumers, or accept it without performing any work.
class Contravariant f => Divisible f where
  conquer :: f a
  divide :: (a -> (b, c)) -> f b -> f c -> f a

-- A validator consumes an input and returns all errors it finds.
newtype Validator e a = Validator { runValidator :: a -> [e] }

instance Contravariant (Validator e) where
  contramap f (Validator validate) = Validator (validate . f)

instance Divisible (Validator e) where
  conquer = Validator (const [])

  divide split (Validator validateB) (Validator validateC) =
    Validator $ \a ->
      let (b, c) = split a
      in validateB b <> validateC c

data User = User
  { userEmail :: String
  , userAge :: Int
  } deriving (Show)

validateEmail :: Validator String String
validateEmail = Validator $ \email ->
  ["Invalid email" | '@' `notElem` email]

validateAge :: Validator String Int
validateAge = Validator $ \age ->
  ["Must be 18+" | age < 18]

-- Usage: Validate multiple fields simultaneously
validateUser :: Validator String User
validateUser = divide
  (\user -> (userEmail user, userAge user))
  validateEmail
  validateAge

-- Validate just one field by adapting an existing validator.
validateUserEmail :: Validator String User
validateUserEmail = contramap userEmail validateEmail

-- A Divisible consumer can choose to accept every input.
acceptAnyUser :: Validator String User
acceptAnyUser = conquer

displayValidation :: String -> Validator String a -> a -> IO ()
displayValidation label validator value =
  putStrLn $ label ++ ": " ++ case runValidator validator value of
    [] -> "valid"
    errors -> unwords errors

-- Test cases
main :: IO ()
main = do
  let validUser = User "alice@example.com" 30
      invalidEmail = User "alice.example.com" 30
      invalidAge = User "alice@example.com" 16
      invalidUser = User "alice.example.com" 16

  putStrLn "Individual field validators:"
  displayValidation "email" validateEmail "alice.example.com"
  displayValidation "age" validateAge 16

  putStrLn "\ncontramap projects a User to the field being validated:"
  displayValidation "email only" validateUserEmail invalidEmail

  putStrLn "\ndivide validates both fields and accumulates errors:"
  displayValidation (show validUser) validateUser validUser
  displayValidation (show invalidEmail) validateUser invalidEmail
  displayValidation (show invalidAge) validateUser invalidAge
  displayValidation (show invalidUser) validateUser invalidUser

  putStrLn "\nconquer accepts without validation:"
  displayValidation (show invalidUser) acceptAnyUser invalidUser

Example 2 - Serialization/Encoding:

interface Encoder<A> {
  encode: (value: A) => readonly string[]
}

// Divisible instance for Encoder
const conquer = <A>(): Encoder<A> => ({
  encode: (_) => []
})

const divide = <A, B, C>(
  split: (a: A) => [B, C],
  encodeB: Encoder<B>,
  encodeC: Encoder<C>
): Encoder<A> => ({
  encode: (a: A) => {
    const [b, c] = split(a)
    return [...encodeB.encode(b), ...encodeC.encode(c)]
  }
})

// Usage: Encode complex objects by splitting them
interface Person {
  name: string
  age: number
}

const stringEncoder: Encoder<string> = { encode: s => [JSON.stringify(s)] }
const numberEncoder: Encoder<number> = { encode: n => [n.toString()] }

const personEncoder: Encoder<Person> = divide(
  (p: Person) => [p.name, p.age],
  stringEncoder,
  numberEncoder
)
console.log(personEncoder.encode({name: "Alice", age: 30}).join(","))
// Result: "Alice",30

Example 3 - Input Parsing/Consumption:

import Data.Functor.Contravariant (Contravariant (contramap))

-- Contravariant equivalent of Applicative: split an input between two
-- consumers, or accept an input without doing anything.
class Contravariant f => Divisible f where
  conquer :: f a
  divide :: (a -> (b, c)) -> f b -> f c -> f a

-- A side-effecting operation that consumes an input contravariantly.
newtype Consumer a = Consumer
  { runConsumer :: a -> IO ()
  }

instance Contravariant Consumer where
  contramap f (Consumer consume) = Consumer (consume . f)

instance Divisible Consumer where
  conquer = Consumer (\_ -> pure ())

  divide split (Consumer consumeB) (Consumer consumeC) =
    Consumer $ \a -> do
      let (b, c) = split a
      consumeB b
      consumeC c

data Customer = Customer
  { customerEmail :: String
  } deriving Show

data Order = Order
  { orderNumber :: Int
  , orderCustomer :: Customer
  } deriving Show

sendEmail :: String -> String -> IO ()
sendEmail address subject =
  putStrLn $ "Email to " ++ address ++ ": " ++ subject

logOrder :: Consumer Order
logOrder = Consumer $ \order ->
  putStrLn $ "Processing order #" ++ show (orderNumber order)

emailAddress :: Consumer String
emailAddress = Consumer $ \address ->
  sendEmail address "Order confirmed"

-- Adapt an email-address consumer to consume a complete Customer.
emailCustomer :: Consumer Customer
emailCustomer = contramap customerEmail emailAddress

-- Usage: Process complex data by splitting responsibilities
processOrder :: Consumer Order
processOrder = divide orderSplit logOrder emailCustomer
  where
    orderSplit order = (order, orderCustomer order)

ignoreOrder :: Consumer Order
ignoreOrder = conquer

-- Test cases
main :: IO ()
main = do
  let customer = Customer "customer@example.com"
      order = Order 12345 customer

  putStrLn "Input values:"
  print customer
  print order

  putStrLn "\nRun a consumer adapted with contramap:"
  runConsumer emailCustomer customer

  putStrLn "\nRun the combined consumer built with divide:"
  runConsumer processOrder order

  putStrLn "\nRun the no-op consumer built with conquer:"
  runConsumer ignoreOrder order
  putStrLn "No action was performed."

Visual Pattern Recognition:

Applicative Pattern:
┌─────┐  ┌─────┐      ┌─────────┐
│  A  │  │  B  │ ---> │ (A, B)  │
└─────┘  └─────┘      └─────────┘

"Combine independent values"

Divisible Runtime Data Flow:
┌─────────┐       ┌─────┐  ┌─────┐
│    A    │ --->  │  B  │  │  C  │
└─────────┘       └─────┘  └─────┘

"Split single value into independent parts"

Divisible is the Contravariant Analogue:

1. Direction: Applicative builds up, Divisible tears down
2. Independence: Both maintain computational independence
3. Composition: Both allow modular, composable operations
4. Error Handling: Both can accumulate results (success/failure)

Programming Applications:

• Form Validation: Split complex forms into field validations
• Serialization: Decompose objects for encoding
• Logging: Split events into multiple log destinations
• Testing: Divide assertions across different aspects
• Configuration: Split settings into independent validators

Alternative - Decidable #

A Decidable functor is the contravariant dual of Alternative. Where Alternative provides choice between computations that might succeed or fail, Decidable provides choice between consumers based on input discrimination.

Given a contravariant functor f, Decidable f provides:

• lose: An "impossible" computation for inputs that cannot exist
• choose: Select between two consumers based on input analysis

Decidable Laws:

class Contravariant f => Decidable f where
  lose :: (a -> Void) -> f a
  choose :: (a -> Either b c) -> f b -> f c -> f a

Laws:

1. Left Identity: choose Left m (lose id) ≡ m
2. Right Identity: choose Right (lose id) m ≡ m
3. Associativity: choose operations can be regrouped without changing semantics

Choice vs Selection:

Alternative construction:
f a + f a -- (<|>) --> f a

Decidable construction:
(a -> Either b c) + f b + f c -- choose --> f a

Runtime flow through the resulting consumer:
a -- discriminate --> Left b  -- consumed by --> f b
                   \-> Right c -- consumed by --> f c

Example 1 - Input Routing/Discrimination:

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE EmptyCase #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
import Data.Void
import Data.Functor.Contravariant hiding (Predicate)

-- Decidable typeclass definition
class Contravariant f => Decidable f where
  lose :: (a -> Void) -> f a
  choose :: (a -> Either b c) -> f b -> f c -> f a

-- Predicate that can handle impossible cases
newtype Predicate a = Predicate (a -> Bool)

instance Contravariant Predicate where
  contramap f (Predicate p) = Predicate (p . f)

instance Decidable Predicate where
  lose f = Predicate (absurd . f)  -- impossible input

  choose split (Predicate pb) (Predicate pc) =
    Predicate $ \a -> case split a of
      Left b -> pb b
      Right c -> pc c

-- Usage: Route different types of input to appropriate handlers
data Input = TextInput String | NumberInput Int

-- Predicates for specific input types
isLongText :: Predicate String
isLongText = Predicate ((>= 10) . length)

isEvenNumber :: Predicate Int
isEvenNumber = Predicate even

-- Combined predicate that routes based on input type
isValidInput :: Predicate Input
isValidInput = choose inputSplit isLongText isEvenNumber
  where
    inputSplit = \case
      TextInput s -> Left s
      NumberInput n -> Right n

-- Another routing example using a different sum type
data Shape = Circle Double | Rectangle Double Double

-- Separate predicates for different shape properties
isLargeCircle :: Predicate Double
isLargeCircle = Predicate (> 10)

isWideRectangle :: Predicate (Double, Double)
isWideRectangle = Predicate (\(w, h) -> w > h * 2)

-- Route shapes to appropriate predicates
shapeValidator :: Predicate Shape
shapeValidator = choose shapeRoute isLargeCircle isWideRectangle
  where
    shapeRoute shape = case shape of
      Circle r -> Left r
      Rectangle w h -> Right (w, h)

-- Example demonstrating 'lose' with a truly impossible type
data Impossible  -- uninhabited type (no constructors)

-- This predicate handles the impossible case
impossiblePredicate :: Predicate Impossible
impossiblePredicate = lose (\case {})  -- empty case analysis proves impossibility

-- Attach an impossible branch to a real predicate. A value of type Void
-- cannot be constructed, so only the Left branch can occur.
leftOnlyValidator :: Predicate a -> Predicate (Either a Void)
leftOnlyValidator validator = choose id validator (lose id)

-- Test cases
main :: IO ()
main = do
  let (Predicate test) = isValidInput
  print $ test (TextInput "Hello World!")  -- True (long text)
  print $ test (TextInput "Hi")            -- False (short text)
  print $ test (NumberInput 42)            -- True (even number)
  print $ test (NumberInput 13)            -- False (odd number)

  -- Test shape validation
  let (Predicate shapeTest) = shapeValidator
  print $ shapeTest (Circle 15.0)          -- True (large circle)
  print $ shapeTest (Circle 5.0)           -- False (small circle)
  print $ shapeTest (Rectangle 20.0 5.0)   -- True (wide rectangle)
  print $ shapeTest (Rectangle 10.0 10.0)  -- False (square)

  -- Demonstrate 'lose' with impossible predicate
  putStrLn "Impossible predicate defined for theoretical completeness"
  -- Note: impossiblePredicate can never be called with actual input

  -- Demonstrate the left identity law for choose/lose
  let (Predicate leftOnlyTest) = leftOnlyValidator isEvenNumber
  print $ leftOnlyTest (Left 42)         -- True (even number)
  print $ leftOnlyTest (Left 13)         -- False (odd number)
  -- There is no total way to construct a value of Right Void.

Example 2 - Error Handling/Logging:

interface Logger<A> {
  log: (value: A) => void
}

type Either<B, C> =
  | { tag: 'left', value: B }
  | { tag: 'right', value: C }

const left = <B, C = never>(value: B): Either<B, C> =>
  ({ tag: 'left', value })

const right = <C, B = never>(value: C): Either<B, C> =>
  ({ tag: 'right', value })

// Decidable instance for Logger
const lose = <A>(impossible: (a: A) => never): Logger<A> => ({
  log: impossible
})

const choose = <A, B, C>(
  discriminate: (a: A) => Either<B, C>,
  loggerB: Logger<B>,
  loggerC: Logger<C>
): Logger<A> => ({
  log: (a: A) => {
    const result = discriminate(a)
    if (result.tag === 'left') {
      loggerB.log(result.value)
    } else {
      loggerC.log(result.value)
    }
  }
})

// Usage: Route different log levels to appropriate handlers
type LogLevel = 'INFO' | 'ERROR'

interface LogEntry {
  level: LogLevel
  message: string
  timestamp: Date
}

const infoLogger: Logger<string> = {
  log: (msg) => console.log(`INFO: ${msg}`)
}

const errorLogger: Logger<string> = {
  log: (msg) => console.error(`ERROR: ${msg}`)
}

const routeLogger: Logger<LogEntry> = choose(
  (entry: LogEntry) => entry.level === 'INFO'
    ? left<string, string>(entry.message)
    : right<string, string>(entry.message),
  infoLogger,
  errorLogger
)

// More sophisticated: Route by content type
type Content = { type: 'success', data: string } | { type: 'error', error: Error }

const successLogger: Logger<string> = {
  log: (data) => console.log(`✓ ${data}`)
}

const failureLogger: Logger<Error> = {
  log: (error) => console.error(`✗ ${error.message}`)
}

const contentLogger: Logger<Content> = choose(
  (content: Content) => content.type === 'success'
    ? left<string, Error>(content.data)
    : right<Error, string>(content.error),
  successLogger,
  failureLogger
)

// Example usage and execution
const testLogEntries: LogEntry[] = [
  { level: 'INFO', message: 'User logged in', timestamp: new Date() },
  { level: 'ERROR', message: 'Database connection failed', timestamp: new Date() },
  { level: 'INFO', message: 'File uploaded successfully', timestamp: new Date() }
]

const testContent: Content[] = [
  { type: 'success', data: 'Payment processed' },
  { type: 'error', error: new Error('Invalid credit card') },
  { type: 'success', data: 'Order confirmed' }
]

console.log('=== Routing Log Entries ===')
testLogEntries.forEach(entry => {
  routeLogger.log(entry)
})

console.log('\n=== Routing Content by Type ===')
testContent.forEach(content => {
  contentLogger.log(content)
})

// Output:
// === Routing Log Entries ===
// INFO: User logged in
// ERROR: Database connection failed
// INFO: File uploaded successfully
//
// === Routing Content by Type ===
// ✓ Payment processed
// ✗ Invalid credit card
// ✓ Order confirmed

Example 3 - Form Validation with Branching:

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE EmptyCase #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
import Data.Void
import Data.Functor.Contravariant hiding (Predicate)
import Data.Time

-- Decidable typeclass definition (if not already defined)
class Contravariant f => Decidable f where
  lose :: (a -> Void) -> f a
  choose :: (a -> Either b c) -> f b -> f c -> f a

-- Validation that can discriminate between different error types
data ValidationError
  = NameError String
  | EmailError String
  | AgeError String
  deriving (Show, Eq)

newtype Validator a = Validator (a -> [ValidationError])

instance Contravariant Validator where
  contramap f (Validator validate) = Validator (validate . f)

instance Decidable Validator where
  lose f = Validator (absurd . f)

  choose split (Validator vb) (Validator vc) =
    Validator $ \a -> case split a of
      Left b -> vb b
      Right c -> vc c

-- Helper function to run validator
runValidator :: Validator a -> a -> [ValidationError]
runValidator (Validator validate) = validate

-- Specific validators
emailValidator :: Validator String
emailValidator = Validator $ \email ->
  ([EmailError "Invalid email format - must contain @ and ." | not ('@' `elem` email && '.' `elem` email)])

ageValidator :: Validator Int
ageValidator = Validator $ \age ->
  ([AgeError $ "Invalid age: " ++ show age ++ " (must be 18-120)" | not (age >= 18 && age <= 120)])

-- User data that needs different validation strategies
data UserField = Email String | Age Int
  deriving (Show)

-- Route validation based on field type
fieldValidator :: Validator UserField
fieldValidator = choose fieldSplit emailValidator ageValidator
  where
    fieldSplit = \case
      Email s -> Left s
      Age n -> Right n

-- Complex form with multiple field types
data FormData = FormData
  { fields :: [UserField]
  , submitTime :: UTCTime
  } deriving (Show)

-- Validate entire form by routing each field appropriately
formValidator :: Validator FormData
formValidator = contramap fields (listValidator fieldValidator)
  where
    listValidator :: Validator a -> Validator [a]
    listValidator (Validator validate) = Validator (concatMap validate)

-- Additional validators for demonstration
nameValidator :: Validator String
nameValidator = Validator $ \name ->
  [ NameError "Name must be at least 2 characters and contain only letters and spaces"
  | not (length name >= 2 && all (`elem` "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ ") name)
  ]

-- Example using 'lose' for impossible/uninhabited types
data Impossible  -- uninhabited type (no constructors)

-- This validator handles the impossible case using 'lose'
impossibleValidator :: Validator Impossible
impossibleValidator = lose (\case {})  -- empty case analysis proves impossibility

-- Optional values have two inhabited branches, so the absent branch gets a
-- real validator rather than being incorrectly routed through 'lose'.
data OptionalField a = Present a | Absent
  deriving (Show)

acceptUnit :: Validator ()
acceptUnit = Validator (const [])

optionalValidator :: Validator a -> Validator (OptionalField a)
optionalValidator validator = choose routeOptional validator acceptUnit
  where
    routeOptional field = case field of
      Present a -> Left a
      Absent -> Right ()

-- Combined user validator using multiple field types
data User = User
  { userName :: String
  , userEmail :: String
  , userAge :: Int
  } deriving (Show)

userValidator :: Validator User
userValidator = divideValidator
  (\user -> (userName user, (userEmail user, userAge user)))
  nameValidator
  (divideValidator id emailValidator ageValidator)
  where
    -- Product validation is Divisible-like: unlike 'choose', it runs both
    -- validators and accumulates their errors.
    divideValidator split (Validator validateB) (Validator validateC) =
      Validator $ \a ->
        let (b, c) = split a
        in validateB b <> validateC c

-- Test cases and main function
main :: IO ()
main = do
  putStrLn "=== Form Validation with Decidable Pattern ==="

  -- Test individual field validation
  putStrLn "\n--- Testing Individual Fields ---"
  let testFields =
        [ Email "user@example.com"
        , Email "invalid-email"
        , Age 25
        , Age 15
        , Age 150
        ]

  mapM_ testField testFields

  -- Test form validation
  putStrLn "\n--- Testing Complete Forms ---"
  currentTime <- getCurrentTime

  let validForm = FormData
        [ Email "alice@company.com"
        , Age 30
        , Email "bob@university.edu"
        , Age 22
        ] currentTime

  let invalidForm = FormData
        [ Email "bad-email"
        , Age 16
        , Email "another@bad"
        , Age 200
        ] currentTime

  testForm validForm
  testForm invalidForm

  -- Test user validation
  putStrLn "\n--- Testing User Validation ---"
  let validUser = User "Alice Smith" "alice@example.com" 25
  let invalidUser = User "X" "bad-email" 15

  testUser validUser
  testUser invalidUser

  -- Test optional field validation
  putStrLn "\n--- Testing Optional Field Validation ---"
  let presentField = Present "test@example.com"
  let absentField = Absent

  testOptionalField presentField
  testOptionalField absentField

  -- Demonstrate the legitimate use of lose with an uninhabited type
  putStrLn "\n--- Impossible Validator (theoretical completeness) ---"
  putStrLn "impossibleValidator is defined but cannot be called with actual input"
  putStrLn "This demonstrates the 'lose' operation for uninhabited types"

testField :: UserField -> IO ()
testField field = do
  let errors = runValidator fieldValidator field
  putStr $ "Field " ++ show field ++ ": "
  if null errors
    then putStrLn "✓ Valid"
    else putStrLn $ "✗ Errors: " ++ show errors

testForm :: FormData -> IO ()
testForm form = do
  let errors = runValidator formValidator form
  putStr $ "Form with " ++ show (length (fields form)) ++ " fields: "
  if null errors
    then putStrLn "✓ All fields valid"
    else putStrLn $ "✗ Validation errors: " ++ show errors

testUser :: User -> IO ()
testUser user = do
  let errors = runValidator userValidator user
  putStr $ "User " ++ userName user ++ ": "
  if null errors
    then putStrLn "✓ Valid"
    else putStrLn $ "✗ Errors: " ++ show errors

testOptionalField :: OptionalField String -> IO ()
testOptionalField field = do
  let emailOptValidator = optionalValidator emailValidator
  let errors = runValidator emailOptValidator field
  putStr $ "Optional field " ++ show field ++ ": "
  if null errors
    then putStrLn "✓ Valid"
    else putStrLn $ "✗ Errors: " ++ show errors

Example 4 - Protocol Handlers:

// C# example with protocol message routing
using System;

public interface IMessageHandler<in T>
{
    void Handle(T message);
}

// Implementation of the routing handler (for 'choose' operation)
public class RoutingHandler<T, B, C> : IMessageHandler<T>
{
    private readonly Func<T, Either<B, C>> discriminate;
    private readonly IMessageHandler<B> handlerB;
    private readonly IMessageHandler<C> handlerC;

    public RoutingHandler(
        Func<T, Either<B, C>> discriminate,
        IMessageHandler<B> handlerB,
        IMessageHandler<C> handlerC)
    {
        this.discriminate = discriminate;
        this.handlerB = handlerB;
        this.handlerC = handlerC;
    }

    public void Handle(T message)
    {
        var result = discriminate(message);
        if (result.IsLeft)
        {
            handlerB.Handle(result.Left);
        }
        else
        {
            handlerC.Handle(result.Right);
        }
    }
}

// Decidable-like operations
public static class MessageRouter
{
    public static IMessageHandler<T> Choose<T, B, C>(
        Func<T, Either<B, C>> discriminate,
        IMessageHandler<B> handlerB,
        IMessageHandler<C> handlerC) =>
        new RoutingHandler<T, B, C>(discriminate, handlerB, handlerC);
}

public class Either<TLeft, TRight>
{
    public bool IsLeft { get; }
    public TLeft Left { get; }
    public TRight Right { get; }

    private Either(bool isLeft, TLeft left, TRight right)
    {
        IsLeft = isLeft;
        Left = left;
        Right = right;
    }

    public static Either<TLeft, TRight> NewLeft(TLeft value) =>
        new(true, value, default!);

    public static Either<TLeft, TRight> NewRight(TRight value) =>
        new(false, default!, value);
}

// Protocol messages
public record NetworkMessage;
public record HttpRequest(string Url, string Method) : NetworkMessage;
public record WebSocketMessage(string Data) : NetworkMessage;

// Specific handlers
public class HttpHandler : IMessageHandler<HttpRequest>
{
    public void Handle(HttpRequest request) =>
        Console.WriteLine($"HTTP {request.Method} {request.Url}");
}

public class WebSocketHandler : IMessageHandler<WebSocketMessage>
{
    public void Handle(WebSocketMessage message) =>
        Console.WriteLine($"WebSocket: {message.Data}");
}

// Route messages based on protocol type
public class NetworkMessageHandler : IMessageHandler<NetworkMessage>
{
    private readonly IMessageHandler<NetworkMessage> router;

    public NetworkMessageHandler()
    {
        router = MessageRouter.Choose<NetworkMessage, HttpRequest, WebSocketMessage>(
            message => message switch
            {
                HttpRequest req => Either<HttpRequest, WebSocketMessage>.NewLeft(req),
                WebSocketMessage ws => Either<HttpRequest, WebSocketMessage>.NewRight(ws),
                _ => throw new ArgumentException("Unknown message type")
            },
            new HttpHandler(),
            new WebSocketHandler()
        );
    }

    public void Handle(NetworkMessage message) => router.Handle(message);
}

// Example usage and main program
public class Program
{
    public static void Main(string[] args)
    {
        Console.WriteLine("=== C# Decidable Pattern: Protocol Message Routing ===\n");

        // Create the main message handler
        var messageHandler = new NetworkMessageHandler();

        // Test messages
        var testMessages = new NetworkMessage[]
        {
            new HttpRequest("https://api.example.com/users", "GET"),
            new WebSocketMessage("Hello from WebSocket!"),
            new HttpRequest("https://api.example.com/orders", "POST"),
            new WebSocketMessage("Real-time update: Order #123 shipped"),
            new HttpRequest("https://api.example.com/products/42", "PUT")
        };

        Console.WriteLine("Processing messages through Decidable router:\n");

        // Process each message - the router will automatically discriminate
        // and route to the appropriate handler
        foreach (var message in testMessages)
        {
            Console.Write($"Message: {message.GetType().Name} -> ");
            messageHandler.Handle(message);
        }

        Console.WriteLine("\n=== Advanced Example: Multi-level Routing ===\n");

        // Create a more sophisticated router that handles errors
        var advancedHandler = CreateAdvancedHandler();

        var advancedMessages = new object[]
        {
            new HttpRequest("https://secure.api.com/auth", "POST"),
            new WebSocketMessage("User connected"),
            "Invalid message type",  // This will route to error handler
            new HttpRequest("https://api.com/data", "GET")
        };

        foreach (var message in advancedMessages)
        {
            Console.Write($"Processing: {message.GetType().Name} -> ");
            try
            {
                advancedHandler.Handle(message);
            }
            catch (Exception ex)
            {
                Console.WriteLine($"Error: {ex.Message}");
            }
        }

        // C# has no ordinary, non-null uninhabited type. A general 'lose'
        // operation therefore cannot be implemented safely without adding a
        // convention such as throwing an exception. The Haskell examples use
        // Void, where the impossibility is represented by the type system.
    }

    // Advanced handler that includes error handling
    private static IMessageHandler<object> CreateAdvancedHandler()
    {
        return MessageRouter.Choose<object, NetworkMessage, string>(
            input => input switch
            {
                NetworkMessage netMsg => Either<NetworkMessage, string>.NewLeft(netMsg),
                string str => Either<NetworkMessage, string>.NewRight(str),
                _ => Either<NetworkMessage, string>.NewRight($"Unknown type: {input.GetType().Name}")
            },
            new NetworkMessageHandler(),  // Handle valid network messages
            new ErrorHandler()            // Handle errors/invalid messages
        );
    }
}

// Error handler for invalid message types
public class ErrorHandler : IMessageHandler<string>
{
    public void Handle(string error)
    {
        Console.WriteLine($"ERROR: {error}");
    }
}

Visual Pattern Recognition:

Alternative Pattern:
┌─────┐     ┌─────┐
│  A  │ <|> │  A  │
└─────┘     └─────┘
     │         │
     └─── OR ──┘

"Combine choices according to the instance"

Decidable Pattern:
      ┌─────┐
      │  A  │
      └──┬──┘
         │
    discriminate
    ┌────┴────┐
    ▼         ▼
┌─────┐   ┌─────┐
│  B  │   │  C  │
└─────┘   └─────┘

"Route based on input analysis"

Decidable is the Contravariant Analogue:

1. Direction: Alternative tries alternatives, Decidable routes to alternatives
2. Failure Handling: Alternative handles computation failure, Decidable handles impossible inputs
3. Choice Mechanism: Alternative chooses between computations, Decidable chooses between consumers
4. Composition: Both allow modular, composable choice operations

Programming Applications:

• Message Routing: Direct different message types to appropriate handlers
• Input Validation: Route different input types to specialized validators
• Protocol Handling: Discriminate between protocol types and route accordingly
• Error Handling: Route different error types to specialized handlers
• Content Processing: Route content based on type/format to appropriate processors
• Event Dispatching: Route events to handlers based on event type

The Complete Analogy:

Choice Operations:
Alternative: f a + f a -- (<|>) --> f a
Decidable:   (a -> Either b c) + f b + f c -- choose --> f a

Failure Operations:
Alternative: empty (no successful computation)
Decidable:   lose (impossible input case)

Identity:
Alternative: empty is the left and right identity of (<|>)
Decidable:   lose supplies an impossible branch for choose

Runtime behavior:
Alternative: execute the choice strategy of the instance
Decidable:   discriminate the input and run exactly one consumer

You're using decidable patterns when:

• Routing systems: Directing traffic based on message/request type
• Validation frameworks: Different validation rules for different data types
• Protocol stacks: Handling different protocol types with specialized logic
• Event systems: Dispatching events to type-specific handlers
• Content management: Processing different content types with appropriate handlers

Monad - Comonad #

As you can see, duality is everywhere. Time for the monads to show their dual nature.

A Comonad is the categorical dual of a Monad. Where monads wrap values in computational contexts, comonads extract values from spatial/positional contexts.

A comonad w is an endofunctor equipped with two natural transformations:

• extract: w a -> a (dual of return/pure)
• duplicate: w a -> w (w a) (dual of join)

From these, we derive:

• extend: (w a -> b) -> w a -> w b (dual of bind)

Comonad Laws:

class Functor w => Comonad w where
  extract :: w a -> a           -- dual of return/pure
  duplicate :: w a -> w (w a)   -- dual of join
  extend :: (w a -> b) -> w a -> w b -- dual of bind

Laws (dual to monad laws):

1. Extract-Extend: extend extract = id
2. Extend-Extract: extract . extend f = f
3. Extend-Extend: extend f . extend g = extend (f . extend g)

The Fundamental Duality:

Monad (Context Injection):
a       ----- return --->  m a     (wrap value in context)
(m a, a -> m b) -- bind --> m b     (transform in context)
m (m a) ------ join ---->  m a      (flatten nested contexts)

Comonad (Context Extraction):
w a ---- extract ---->   a       (extract value from context)
(w a, w a -> b) - extend -> w b     (transform with context awareness)
w a --- duplicate --->   w (w a)    (provide nested context access)

Example 1 - Infinite Streams (Context = Position):

{-# LANGUAGE DeriveFunctor #-}
import Control.Comonad

-- An infinite stream. For a tape, the head of each side is the value
-- immediately adjacent to the focus.
data Stream a = a :< Stream a
  deriving Functor

data Tape a = Tape (Stream a) a (Stream a)
  deriving Functor

repeatS :: a -> Stream a
repeatS x = x :< repeatS x

iterateS :: (a -> a) -> a -> Stream a
iterateS f x = f x :< iterateS f (f x)

takeS :: Int -> Stream a -> [a]
takeS n _ | n <= 0 = []
takeS n (x :< xs) = x : takeS (n-1) xs

moveLeft :: Tape a -> Tape a
moveLeft (Tape (l :< ls) focus rs) = Tape ls l (focus :< rs)

moveRight :: Tape a -> Tape a
moveRight (Tape ls focus (r :< rs)) = Tape (focus :< ls) r rs

instance Comonad Tape where
  extract (Tape _ focus _) = focus

  duplicate tape = Tape
    (iterateS moveLeft tape)
    tape
    (iterateS moveRight tape)

  extend f = fmap f . duplicate

-- A finite seed embedded in an infinite background. The first seed value is
-- focused; values outside the seed are the supplied background value.
fromListWithDefault :: a -> [a] -> Tape a
fromListWithDefault background [] =
  Tape (repeatS background) background (repeatS background)
fromListWithDefault background (x:xs) =
  Tape (repeatS background) x (appendDefault xs)
  where
    appendDefault [] = repeatS background
    appendDefault (y:ys) = y :< appendDefault ys

getNeighbors :: Tape a -> (a, a, a)
getNeighbors (Tape (left :< _) current (right :< _)) =
  (left, current, right)

-- Rule 30: left XOR (center OR right)
rule30 :: Tape Bool -> Bool
rule30 tape =
  let (left, current, right) = getNeighbors tape
  in left /= (current || right)

-- Apply rule to entire stream (next generation)
nextGeneration :: (Tape Bool -> Bool) -> Tape Bool -> Tape Bool
nextGeneration rule = extend rule

initialPattern :: Tape Bool
initialPattern = fromListWithDefault False [True]

-- Run simulation for n steps
runSimulation :: Int -> (Tape Bool -> Bool) -> Tape Bool -> [Tape Bool]
runSimulation 0 _ stream = [stream]
runSimulation n rule stream =
  stream : runSimulation (n-1) rule (nextGeneration rule stream)

displayGeneration :: Int -> Tape Bool -> String
displayGeneration radius (Tape left focus right) =
  map displayCell $
    reverse (takeS radius left) ++ [focus] ++ takeS radius right
  where
    displayCell alive = if alive then '#' else '.'

main :: IO ()
main = do
  putStrLn "1D cellular automaton using a comonadic tape"
  let generations = runSimulation 10 rule30 initialPattern
  mapM_ (putStrLn . displayGeneration 15) generations

• extract: Gets the focused cell value
• duplicate: Creates a stream of all possible focus positions
• extend: Applies cellular automaton rules to every position simultaneously

This makes the comonad pattern concrete: each cell's next state depends on its local neighborhood context, which is exactly what comonads excel at modeling.

Example 2 - UI Components (Context = Environment):

A component can be modeled with the Store comonad: it contains a renderer for every possible environment together with the environment currently in focus.

interface Theme {
  name: string
  primaryColor: string
  backgroundColor: string
}

interface User {
  id: number
  name: string
  email: string
  role: 'user' | 'admin'
}

interface Permission {
  action: string
  resource: string
}

interface Environment {
  theme: Theme
  user: User
  permissions: readonly Permission[]
}

// Store<S, A> contains a value for every position S and a current position.
interface Store<S, A> {
  position: S
  peek: (position: S) => A
}

const mapStore = <S, A, B>(f: (value: A) => B) =>
  (store: Store<S, A>): Store<S, B> => ({
    position: store.position,
    peek: (position) => f(store.peek(position))
  })

const seek = <S, A>(position: S, store: Store<S, A>): Store<S, A> => ({
  position,
  peek: store.peek
})

const extract = <S, A>(store: Store<S, A>): A =>
  store.peek(store.position)

const duplicate = <S, A>(
  store: Store<S, A>
): Store<S, Store<S, A>> => ({
  position: store.position,
  peek: (position) => ({
    position,
    peek: store.peek
  })
})

const extend = <S, A, B>(f: (store: Store<S, A>) => B) =>
  (store: Store<S, A>): Store<S, B> => ({
    position: store.position,
    peek: (position) => f({
      position,
      peek: store.peek
    })
  })

type Component<A> = Store<Environment, A>

const makeComponent = <A>(
  environment: Environment,
  render: (environment: Environment) => A
): Component<A> => ({
  position: environment,
  peek: render
})

const hasPermission = (
  environment: Environment,
  action: string,
  resource: string
): boolean =>
  environment.permissions.some(
    permission =>
      permission.action === action && permission.resource === resource
  )

const lightEnvironment: Environment = {
  theme: {
    name: 'Light',
    primaryColor: '#333333',
    backgroundColor: '#ffffff'
  },
  user: {
    id: 1,
    name: 'Alice Smith',
    email: 'alice@example.com',
    role: 'user'
  },
  permissions: [
    { action: 'read', resource: 'profile' },
    { action: 'write', resource: 'profile' }
  ]
}

const darkEnvironment: Environment = {
  theme: {
    name: 'Dark',
    primaryColor: '#ffffff',
    backgroundColor: '#333333'
  },
  user: {
    id: 2,
    name: 'Bob Admin',
    email: 'bob@admin.com',
    role: 'admin'
  },
  permissions: [
    { action: 'read', resource: 'profile' },
    { action: 'write', resource: 'profile' },
    { action: 'read', resource: 'users' }
  ]
}

// The renderer works at every environment; lightEnvironment is the focus.
const userProfile: Component<string> = makeComponent(
  lightEnvironment,
  environment => 'Hello, ' + environment.user.name + '!'
)

// extend receives the whole component focused at each environment.
const themedProfile: Component<string> = extend(
  (component: Component<string>) => {
    const environment = component.position
    return '<div style="color: ' + environment.theme.primaryColor +
      '; background: ' + environment.theme.backgroundColor + '">' +
      extract(component) +
      '</div>'
  }
)(userProfile)

const conditionalProfile: Component<string> = extend(
  (component: Component<string>) =>
    hasPermission(component.position, 'read', 'profile')
      ? extract(component)
      : '<div>Access denied</div>'
)(userProfile)

const adminPanel: Component<string> = extend(
  (component: Component<string>) => {
    const environment = component.position
    if (environment.user.role !== 'admin') {
      return extract(component)
    }

    return '<section class="admin-panel"><h2>Admin Dashboard</h2>' +
      extract(component) +
      '<button>Manage Users</button></section>'
  }
)(themedProfile)

const renderAt = <A>(
  environment: Environment,
  component: Component<A>
): A => extract(seek(environment, component))

console.log(renderAt(lightEnvironment, themedProfile))
console.log(renderAt(darkEnvironment, themedProfile))
console.log(renderAt(lightEnvironment, conditionalProfile))
console.log(renderAt(darkEnvironment, adminPanel))

// Check the comonad laws observationally at both environments.
const environments = [lightEnvironment, darkEnvironment]

const extendExtract = extend<Environment, string, string>(extract)(userProfile)
console.log(
  'extend extract = id:',
  environments.every(environment =>
    renderAt(environment, extendExtract) ===
      renderAt(environment, userProfile)
  )
)

const describe = (component: Component<string>): string =>
  component.position.theme.name + ': ' + extract(component)

console.log(
  'extract . extend describe = describe:',
  extract(extend(describe)(userProfile)) === describe(userProfile)
)

const extractedDuplicate = extract(duplicate(userProfile))
console.log(
  'extract . duplicate = id:',
  environments.every(environment =>
    renderAt(environment, extractedDuplicate) ===
      renderAt(environment, userProfile)
  )
)

Example 3 - Grid Computing (Context = Neighborhood):

{-# LANGUAGE DeriveFunctor #-}
import Control.Comonad
import Text.Printf (printf)

-- 2D grid with focus on current cell
data Grid a = Grid
  { gridData :: [[a]]
  , focusX :: Int
  , focusY :: Int
  , gridWidth :: Int
  , gridHeight :: Int
  } deriving (Show, Functor)

-- Create a grid from a 2D list
mkGrid :: [[a]] -> Grid a
mkGrid [] = error "Cannot create empty grid"
mkGrid rows@(r:_)
  | null r = error "Cannot create a grid with empty rows"
  | any ((/= width) . length) rows = error "Grid rows must have equal lengths"
  | otherwise = Grid rows 0 0 width (length rows)
  where
    width = length r

-- Create a grid filled with a value
fillGrid :: Int -> Int -> a -> Grid a
fillGrid w h val
  | w <= 0 || h <= 0 = error "Grid dimensions must be positive"
  | otherwise = Grid (replicate h (replicate w val)) 0 0 w h

-- Safe grid access with bounds checking
safeGet :: Grid a -> Int -> Int -> Maybe a
safeGet (Grid rows _ _ w h) x y
  | x >= 0 && x < w && y >= 0 && y < h = Just $ (rows !! y) !! x
  | otherwise = Nothing

-- Get grid dimensions
gridDimensions :: Grid a -> (Int, Int)
gridDimensions (Grid _ _ _ w h) = (w, h)

-- Move focus to specific coordinates
moveTo :: Int -> Int -> Grid a -> Grid a
moveTo x y grid@(Grid _ _ _ w h)
  | x >= 0 && x < w && y >= 0 && y < h = grid { focusX = x, focusY = y }
  | otherwise = grid

-- Move focus in cardinal directions
moveUp, moveDown, moveLeft, moveRight :: Grid a -> Grid a
moveUp grid@(Grid _ x y _ _) = moveTo x (y - 1) grid
moveDown grid@(Grid _ x y _ _) = moveTo x (y + 1) grid
moveLeft grid@(Grid _ x y _ _) = moveTo (x - 1) y grid
moveRight grid@(Grid _ x y _ _) = moveTo (x + 1) y grid

instance Comonad Grid where
  extract (Grid rows x y _ _) = (rows !! y) !! x

  duplicate grid@(Grid _ _ _ w h) = Grid
    { gridData = [[ moveTo x y grid
                  | x <- [0..w-1]]
                  | y <- [0..h-1]]
    , focusX = focusX grid
    , focusY = focusY grid
    , gridWidth = w
    , gridHeight = h
    }

  extend f grid@(Grid _ _ _ w h) = Grid
    { gridData = [[ f (moveTo x y grid)
                  | x <- [0..w-1]]
                  | y <- [0..h-1]]
    , focusX = focusX grid
    , focusY = focusY grid
    , gridWidth = w
    , gridHeight = h
    }

-- Get all 8 neighbors (Moore neighborhood) including the center
getNeighbors :: Grid a -> [a]
getNeighbors grid@(Grid _ x y _ _) =
  [ value
  | dx <- [-1, 0, 1]
  , dy <- [-1, 0, 1]
  , Just value <- [safeGet grid (x+dx) (y+dy)]
  ]

-- Get 4-connected neighbors (Von Neumann neighborhood)
getNeighbors4 :: Grid a -> [a]
getNeighbors4 grid@(Grid _ x y _ _) =
  [ value
  | (dx, dy) <- [(0,1), (1,0), (0,-1), (-1,0)]
  , Just value <- [safeGet grid (x+dx) (y+dy)]
  ]

-- Count living neighbors for Conway's Game of Life
countLivingNeighbors :: Grid Bool -> Int
countLivingNeighbors grid@(Grid _ x y _ _) =
  length $ filter id
    [ alive
    | dx <- [-1, 0, 1]
    , dy <- [-1, 0, 1]
    , not (dx == 0 && dy == 0)  -- exclude center cell
    , Just alive <- [safeGet grid (x+dx) (y+dy)]
    ]

-- Conway's Game of Life rules
gameOfLifeRule :: Grid Bool -> Bool
gameOfLifeRule grid =
  let current = extract grid
      neighbors = countLivingNeighbors grid
  in case (current, neighbors) of
    (True, 2)  -> True   -- survival with 2 neighbors
    (True, 3)  -> True   -- survival with 3 neighbors
    (False, 3) -> True   -- birth with 3 neighbors
    _          -> False  -- death in all other cases

-- Apply Game of Life rules to entire grid
nextGeneration :: Grid Bool -> Grid Bool
nextGeneration = extend gameOfLifeRule

-- Image processing: blur filter
blur :: Grid Int -> Int
blur grid =
  let neighbors = getNeighbors grid
  in if null neighbors
     then extract grid
     else sum neighbors `div` length neighbors

-- Apply blur filter to entire grid
blurImage :: Grid Int -> Grid Int
blurImage = extend blur

-- Edge detection using simple gradient
edgeDetect :: Grid Int -> Int
edgeDetect grid =
  let current = extract grid
      neighbors = getNeighbors4 grid
      differences = map (abs . (current -)) neighbors
  in if null differences
     then 0
     else maximum differences

-- Apply edge detection to entire grid
detectEdges :: Grid Int -> Grid Int
detectEdges = extend edgeDetect

-- Utility: Convert grid to string for display
showGrid :: Show a => Grid a -> String
showGrid (Grid rows _ _ _ _) =
  unlines $ map (unwords . map show) rows

-- Conway patterns
glider :: Grid Bool
glider = mkGrid
  [ [False, True,  False, False, False]
  , [False, False, True,  False, False]
  , [True,  True,  True,  False, False]
  , [False, False, False, False, False]
  , [False, False, False, False, False]
  ]

blinker :: Grid Bool
blinker = mkGrid
  [ [False, False, False, False, False]
  , [False, False, True,  False, False]
  , [False, False, True,  False, False]
  , [False, False, True,  False, False]
  , [False, False, False, False, False]
  ]

-- Image processing test data
testImage :: Grid Int
testImage = mkGrid
  [ [10, 20, 30, 40, 50]
  , [15, 25, 35, 45, 55]
  , [20, 30, 40, 50, 60]
  , [25, 35, 45, 55, 65]
  , [30, 40, 50, 60, 70]
  ]

-- Display functions for different cell types
displayLife :: Grid Bool -> String
displayLife (Grid rows _ _ _ _) =
  unlines $ map (map (\b -> if b then '#' else '.')) rows

displayImage :: Grid Int -> String
displayImage (Grid rows _ _ _ _) =
  unlines $ map (unwords . map (printf "%2d")) rows

-- Run Conway's Game of Life simulation
runLifeSimulation :: Int -> Grid Bool -> [Grid Bool]
runLifeSimulation 0 grid = [grid]
runLifeSimulation n grid =
  grid : runLifeSimulation (n-1) (nextGeneration grid)

displayIndexedLife :: (Int, Grid Bool) -> IO ()
displayIndexedLife (generation, grid) = do
  putStrLn $ "Generation " ++ show generation ++ ":"
  putStrLn $ displayLife grid

-- Main demonstration
main :: IO ()
main = do
  putStrLn "=== Haskell Comonad: 2D Grid Computing ==="
  putStrLn "Demonstrating spatial context and neighborhood operations\n"

  -- Conway's Game of Life
  putStrLn "=== Conway's Game of Life ==="
  putStrLn "\n--- Glider Pattern Evolution ---"
  let gliderGenerations = runLifeSimulation 4 glider
  mapM_ displayIndexedLife (zip [0..] gliderGenerations)

  putStrLn "\n--- Blinker Pattern Evolution ---"
  let blinkerGenerations = runLifeSimulation 3 blinker
  mapM_ displayIndexedLife (zip [0..] blinkerGenerations)

  -- Image processing
  putStrLn "\n=== Image Processing with Comonad Grid ==="
  putStrLn "\n--- Original Image ---"
  putStrLn $ displayImage testImage

  putStrLn "\n--- Blurred Image ---"
  let blurred = blurImage testImage
  putStrLn $ displayImage blurred

  putStrLn "\n--- Edge Detection ---"
  let edges = detectEdges testImage
  putStrLn $ displayImage edges

  -- Demonstrate comonad operations
  putStrLn "\n=== Demonstrating Comonad Operations ==="

  let grid :: Grid Int
      grid = mkGrid [[1,2,3], [4,5,6], [7,8,9]]
  putStrLn "\nOriginal 3x3 grid:"
  putStrLn $ showGrid grid
  putStrLn $ "Dimensions: " ++ show (gridDimensions grid)

  putStrLn "Create a filled 4x2 grid:"
  let filled :: Grid Int
      filled = fillGrid 4 2 7
  putStrLn $ showGrid filled

  putStrLn "Map over the grid with its Functor instance:"
  putStrLn $ showGrid (fmap (* 10) grid)

  putStrLn "\nFocus on center (1,1) - extract value:"
  let centered = moveTo 1 1 grid
  print $ extract centered

  putStrLn "\nNeighbors of center cell:"
  print $ getNeighbors centered

  putStrLn "\nValues reached by moving from the center:"
  print
    [ ("up", extract $ moveUp centered)
    , ("down", extract $ moveDown centered)
    , ("left", extract $ moveLeft centered)
    , ("right", extract $ moveRight centered)
    ]

  putStrLn "\nSafe access inside and outside the grid:"
  print (safeGet grid 2 2, safeGet grid 3 3)

  putStrLn "\nApply sum function to all positions (extend):"
  let sumGrid = extend (sum . getNeighbors) grid
  putStrLn $ showGrid sumGrid

  -- Demonstrate duplicate operation
  putStrLn "\n=== Demonstrating Duplicate Operation ==="
  let smallGrid :: Grid Int
      smallGrid = mkGrid [[1,2], [3,4]]
  putStrLn "\nSmall 2x2 grid:"
  putStrLn $ showGrid smallGrid

  putStrLn "\nDuplicated grid (grid of grids at each position):"
  let duplicated = duplicate smallGrid
  putStrLn "Each cell now contains a grid focused at that position"
  putStrLn $ "Focus (0,0): " ++ show (extract $ extract $ moveTo 0 0 duplicated)
  putStrLn $ "Focus (1,1): " ++ show (extract $ extract $ moveTo 1 1 duplicated)

  -- Advanced: Custom cellular automaton
  putStrLn "\n=== Custom Cellular Automaton: Majority Rule ==="
  let majorityRule :: Grid Bool -> Bool
      majorityRule neighborhood =
        let neighbors = getNeighbors neighborhood
            trueCount = length $ filter id neighbors
            totalCount = length neighbors
        in trueCount > totalCount `div` 2

  let customPattern = mkGrid
        [ [True,  False, True,  False, True ]
        , [False, True,  False, True,  False]
        , [True,  False, True,  False, True ]
        , [False, True,  False, True,  False]
        , [True,  False, True,  False, True ]
        ]

  putStrLn "\nInitial pattern:"
  putStrLn $ displayLife customPattern

  putStrLn "\nAfter majority rule:"
  let afterMajority = extend majorityRule customPattern
  putStrLn $ displayLife afterMajority

  -- Demonstrate extend composition
  putStrLn "\n=== Comonad Law Demonstration ==="
  putStrLn "Law: extend extract = id"
  let testGrid :: Grid Int
      testGrid = mkGrid [[10, 20], [30, 40]]
  let extendExtract = extend extract testGrid
  putStrLn $ "Original: " ++ showGrid testGrid
  putStrLn $ "extend extract: " ++ showGrid extendExtract
  putStrLn $ "Equal: " ++ show (gridData testGrid == gridData extendExtract)

  putStrLn "\nLaw: extract . extend f = f (for any focused grid)"
  let focused = moveTo 0 0 testGrid
  let f = sum . getNeighbors
  let extractExtendF = extract $ extend f focused
  let directF = f focused
  putStrLn $ "extract (extend f) grid: " ++ show extractExtendF
  putStrLn $ "f grid: " ++ show directF
  putStrLn $ "Equal: " ++ show (extractExtendF == directF)

Visually — The Key Difference:

Monad - Building Context:
  ┌─────┐               ┌─────────────┐
  │  5  │ -- return --> │   Just 5    │
  └─────┘               └─────────────┘
   value                 value + context

Comonad - Using Context:
  ┌──────────────────────────────┐               ┌─────┐
  │ Tape [...,3,4,->5<-,6,7,...] │ -- extract--> │  5  │
  └──────────────────────────────┘               └─────┘
    focused value + context                       value

  ┌──────────────────────────────┐                       ┌─────────────────────────────────┐
  │ Tape [...,3,4,->5<-,6,7,...] │ -- extend sum3 ---->  │ Tape [...,9,12,->15<-,18,21...] │
  └──────────────────────────────┘                       └─────────────────────────────────┘
   sum3 reads the left, focused, and right values at every position

Comonad Applications:

1. Spatial Computing: When position/context determines computation
2. Reactive Systems: UI components that respond to environmental changes
3. Local Transformations: Algorithms that need neighborhood information
4. Dependency Injection: Providing environmental context automatically

Two Different Kinds of Duality:

Covariant abstraction	Contravariant counterpart
Functor	Contravariant functor
Applicative	Divisible
Alternative	Decidable

Monad and comonad form a separate categorical duality. Both are based on covariant functors

Programming Recognition:

You're using comonadic patterns when:

• UI frameworks: Components that render based on environmental context
• Image processing: Filters that consider pixel neighborhoods
• Cellular automata: Rules that depend on local state
• Configuration systems: Settings that depend on environmental context
• Reactive programming: Values that change based on context changes

Visualizing Duality #

The following visualization distinguishes categorical duality from contravariant analogies and separates combinator construction from runtime data flow.

SOURCE STRUCTURES                       DUALS OR CONTRAVARIANT ANALOGUES
─────────────────                       ─────────────────────────────────

Category C                              Opposite Category C^op
┌─────────────┐                        ┌──────────────────┐
│ A ──f──> B  │                        │ A <──f^op── B    │
│ │        │  │       <------>         │ ▲          ▲     │
│ │g       │h │                        │ │g^op      │h^op │
│ ▼        ▼  │                        │ │          │     │
│ C ──k──> D  │                        │ C <──k^op── D    │
└─────────────┘                        └──────────────────┘
h ∘ f = k ∘ g                          f^op ∘ h^op = g^op ∘ k^op

Functor F                              Contravariant Functor F
┌────────────────────┐                 ┌────────────────────┐
│ f: A ────────> B   │                 │ f: A ────────> B   │
│                    │      <---->     │                    │
│ F(A) ───────> F(B) │                 │ F(B) ───────> F(A) │
│       fmap f       │                 │     contramap f    │
└────────────────────┘                 └────────────────────┘
map preserves direction                contramap reverses type flow

Applicative construction               Divisible construction
┌─────┐ ┌─────┐                        ┌───────────────┐ ┌─────┐ ┌─────┐
│ f a │ │ f b │ -- liftA2 (,) -->      │a -> (b, c)    │ │ f b │ │ f c │
└─────┘ └─────┘       f (a, b)         └───────────────┘ └─────┘ └─────┘
                                                   │ divide
                                                   ▼
                                                  f a

Alternative construction               Decidable construction
f a + f a -- (<|>) --> f a              (a -> Either b c) + f b + f c
identity: empty                                      │ choose
                                                     ▼
                                                    f a

Monad (Context Building)                Comonad (Context Using)
a -- pure ----------> m a               w a -- extract --------> a
(m a, a -> m b) -- bind --> m b          (w a, w a -> b) -- extend --> w b
m (m a) -- join ----> m a               w a -- duplicate -----> w (w a)


1. Functor vs Contravariant Functor


COVARIANT FUNCTOR                    CONTRAVARIANT FUNCTOR
─────────────────                    ─────────────────────

Value function: A → B                Value function: A → B
Type flow: F(A) → F(B)               Type flow: F(B) → F(A)

    f: A → B                             f: A → B
┌─────────────┐                      ┌─────────────┐
│      A      │                      │      A      │
│      │      │                      │      │      │
│      │f     │                      │      │f     │
│      ▼      │                      │      ▼      │
│      B      │                      │      B      │
└─────────────┘                      └─────────────┘
       │                                    │
   fmap(f)                            contramap(f)
       │                                    │
       ▼                                    ▲
┌─────────────┐                      ┌─────────────┐
│    F(A)     │                      │    F(A)     │
│      │      │                      │      ▲      │
│      │F(f)  │                      │      │      │
│      ▼      │                      │ contramap f │
│    F(B)     │                      │    F(B)     │
└─────────────┘                      └─────────────┘

Examples:                            Examples:
- List<A> → List<B>                 - Predicate<B> → Predicate<A>
- Option<A> → Option<B>             - Encoder<B> → Encoder<A>
- Future<A> → Future<B>             - Comparison<B> → Comparison<A>


2. Applicative vs Divisible


APPLICATIVE: COMBINING VALUES            DIVISIBLE: BUILDING A CONSUMER
─────────────────────────────            ──────────────────────────────

Independent computations                 Inputs to divide
      ┌─────┐  ┌─────┐              ┌─────────────┐ ┌─────┐ ┌─────┐
      │ f a │  │ f b │              │a -> (b, c)  │ │ f b │ │ f c │
      └──┬──┘  └──┬──┘              └──────┬──────┘ └──┬──┘ └──┬──┘
         │        │                        │           │       │
         └────────┴─────> combine          └───────────┴───────┘
                  │                                 │ divide
              ┌───▼────┐                            ▼
              │f (a,b) │                          ┌─────┐
              └────────┘                          │ f a │
                                                  └──┬──┘
                                                     │ runtime input a
                                                     ▼
                                                  (b, c)
                                                   │   │
                                                 f b   f c

Use Cases:                               Use Cases:
- Form validation (collect)             - Form validation (split)
- Independent effects                   - Serialization
- Configuration parsing                - Multi-destination logging
- Building complex objects             - Multiple input consumers


3. Alternative vs Decidable


PARSER-STYLE ALTERNATIVE EXAMPLE         DECIDABLE: ROUTING TO
                                         CONSUMERS
────────────────────────────────         ─────────────────────

Try Primary, Then Fallback              Discriminate, Then Route
┌─────────┐                                   ┌─────────┐
│ Comp A  │--|                                │ Input A │
└────┬────┘  |                                └────┬────┘
     │       |                                     │
 success  failure                           analyze│
     │       │                                     │
     ▼       │        ┌─────────┐                  ▼
  Result     │        │ Comp B  │              ┌─────────┐
             │        └────┬────┘              │ Either  │
             │             │                   │  B    C │
             └─────────────┴─> Result          └────┼────┘
                                                    │
                                               ┌────┴────┐
                                               │         │
                                           ┌───▼───┐ ┌───▼───┐
                                           │ f b   │ │ f c   │
                                           │consume│ │consume│
                                           └───────┘ └───────┘

Construction:
f a + f a -- (<|>) --> f a              (a -> Either b c) + f b + f c
identity: empty                                      │ choose
                                                     ▼
                                                    f a

Example: Parser Combinators              Example: Message Routing
parseNumber <|> parseString              route message to selected consumer

Empty Case: No valid parse               Lose Case: Impossible input type


4. Monad vs Comonad: The Complete Picture


MONAD: CONTEXT BUILDING                        COMONAD: CONTEXT USING
───────────────────────                        ─────────────────────

Building computational context                Using available context

Step 1: Wrap Value                            Step 1: Extract Value
┌─────┐ return/pure ┌─────────────┐           ┌─────────────┐ extract ┌─────┐
│  a  │ ─────────>  │ Context a   │           │ Context a   │ ──────> │  a  │
└─────┘             └─────────────┘           └─────────────┘         └─────┘
 naked value         wrapped value             value in context       naked value

Step 2: Chain Operations                      Step 2: Context-Aware Transform
┌────────────────────────────┐ bind ┌─────────┐ ┌───────────────────────────┐ extend ┌─────────┐
│Context a + (a -> Context b)│ ───> │Context b│ │Context a + (Context a->b) │ ─────> │Context b│
└────────────────────────────┘      └─────────┘ └───────────────────────────┘        └─────────┘

Step 3: Flatten Nested Context               Step 3: Duplicate Context Access
┌─────────────────┐ join ┌─────────────┐      ┌─────────────┐ duplicate ┌─────────────────┐
│ Context         │ ───> │ Context a   │      │ Context a   │ ────────> │ Context         │
│ (Context a)     │      └─────────────┘      └─────────────┘           │ (Context a)     │
└─────────────────┘                                                     └─────────────────┘
nested contexts          flattened            single context            nested contexts

Examples:                                     Examples:
- Maybe: handling failure                     - Stream: infinite sequences
- List: non-determinism                       - Grid: 2D spatial data
- IO: side effects                            - Env: dependency injection
- State: stateful computation                 - Store: environment-based rendering


5. Spatial Context vs Computational Context


STATE-MONAD EXAMPLE                          GRID-COMONAD EXAMPLE
───────────────────                          ─────────────────────

Sequential state threading                  Spatial neighborhood access
┌────┐ step A ┌─────────┐ step B ┌─────────┐ ┌─────┬─────┬─────┐
│ s0 │ ─────> │ (a, s1) │ ─────> │ (b, s2) │ │  ?  │  ?  │  ?  │
└────┘        └─────────┘        └─────────┘ ├─────┼─────┼─────┤
                                             │  ?  │ !!! │  ?  │  !!! = focus
State is passed from one operation           ├─────┼─────┼─────┤
to the next in this example.                 │  ?  │  ?  │  ?  │
                                             └─────┴─────┴─────┘
                                                      │
                                                      ▼
                                               ┌─────────────┐
                                               │ Neighborhood│
                                               │ Rule        │
                                               └─────────────┘

These are representative examples. Monads are not inherently time-based or
sequential, and comonads are not inherently spatial or parallel.


6. The Duality Principles in Action


CORRESPONDING OPERATIONS
────────────────────────

Level 1: Covariant/Contravariant Mapping
┌─────────────────┐                      ┌──────────────────┐
│ fmap: (a→b) →   │                      │ contramap:       │
│      f a → f b  │         <---->       │ (a→b) → f b → f a│
└─────────────────┘                      └──────────────────┘

Level 2: Applicative/Divisible Analogues
┌──────────────────┐                     ┌──────────────────┐
│ liftA2:          │                     │ divide: (a→(b,c))│
│ (a→b→c) →        │         <---->      │ → f b → f c → f a│
│ f a → f b → f c  │                     └──────────────────┘
└──────────────────┘

Level 3: Monad/Comonad Dual Operations
┌─────────────────┐                      ┌─────────────────┐
│ >>=: m a →      │                      │ extend: (w a→b) │
│      (a→m b)→m b│         <---->       │ → w a → w b     │
└─────────────────┘                      └─────────────────┘

Level 4: Alternative/Decidable Analogues
┌─────────────────┐                      ┌─────────────────┐
│ <|>: f a →      │                      │ choose: (a→     │
│      f a → f a  │         <---->       │ Either b c) →   │
└─────────────────┘                      │ f b → f c → f a │
                                         └─────────────────┘

RECURRING DESIGN INTUITION:
Left side = Building/Combining/Trying
Right side = Analyzing/Splitting/Routing

This is a useful design intuition, not a claim that every operation above is
the categorical dual of the operation beside it.


7. Real Examples


USER INTERFACE: STATE UPDATES vs STORE-BASED RENDERING
───────────────────────────────────────────────────────

State-based update design                 Store-comonad rendering design
┌─────────────┐                           ┌─────────────┐
│   Model     │ --- update ---> Model'    │Environment  │ -- focus -->
│     │       │                           │     │       │
│     │build  │                           │     │render │
│     ▼       │                           │     ▼       │
│    View     │                           │   Output    │
└─────────────┘                           └─────────────┘

State is updated in this design.          Environment determines rendering.
The Store example is comonadic; UI rendering in general is not inherently
comonadic or parallel.


FORM PROCESSING: VALIDATION vs SPLITTING
────────────────────────────────────────

Input Validation (Applicative)         Input Splitting (Divisible)
┌─────┐ ┌─────┐ ┌─────┐                ┌───────────────┐
│Name │ │Email│ │Age  │                │Form Submission│
└──┬──┘ └──┬──┘ └──┬──┘                └──────┬────────┘
   │       │       │                          │split
   │validate     validate                     │
   │       │       │                          ▼
   └───────┼───────┘                    ┌─────┴─────┐
           │                            │   Fields  │
           ▼                            └─────┬─────┘
    ┌─────────────┐                           │
    │Valid Form   │                  ┌────────┼────────┐
    │or Errors    │                  │        │        │
    └─────────────┘                  ▼        ▼        ▼
                                   ┌────┐  ┌─────┐  ┌───┐
Combine results                    │Name│  │Email│  │Age│
                                   │Vld │  │ Vld │  │Vld│
                                   └────┘  └─────┘  └───┘
                                  Feed all validators


ERROR HANDLING: RECOVERY vs DISPATCH
────────────────────────────────────

Error Recovery (Alternative instance) Error Dispatch (Decidable)
┌─────────────┐                     ┌─────────────┐
│Primary Op   │ -- fail -           │   Error     │ -- analyze --
└─────────────┘         │           └─────────────┘             │
                        │                                       │
                        ▼                                       ▼
              ┌─────────────┐                            ┌─────────────┐
              │Fallback Op  │                            │Error Type   │
              └─────────────┘                            └─────────────┘
                        │                                       │
                        ▼                                       │
              ┌─────────────┐                            ┌──────┴──────┐
              │   Result    │                            │             │
              └─────────────┘                            ▼             ▼
                                                    ┌─────────┐   ┌─────────┐
Try alternatives                                    │Handler A│   │Handler B│
                                                    └─────────┘   └─────────┘
                                                   Route to selected handler

These structures reveal recurring dual and contravariant patterns. Monad and comonad are categorical duals; Divisible and Decidable are contravariant analogues of Applicative and Alternative, respectively.

Conclusion #

Through categorical duality and contravariant analogies, we've discovered recurring structure in the programming abstractions we use daily:

• Functors that preserve structure have their contravariant counterparts that reverse it
• Applicatives that combine independent values pair with divisibles that split single inputs
• Alternatives that choose between computations complement decidables that route to handlers
• Monads that build computational contexts balance with comonads that extract from spatial contexts

The Principle of Computational Completeness: Every forward operation needs its backward counterpart for full expressiveness. You cannot just build — you must also be able to analyze. You cannot only combine — you must also be able to separate. Category theory makes this intuition precise.

The Recognition of Hidden Duality: Every time you write a comparison function, validate form inputs, or render UI components, you're leveraging these dualities. The patterns we've formalized were already present in your code — category theory simply reveals their structure.

The Power of Systematic Thinking: By understanding duality at the categorical level, we gain a systematic way to:

• Predict what abstractions should exist (if there's a forward operation, there should be a backward one)
• Design better APIs (ensure both building and analyzing operations are available)
• Recognize when we're missing computational tools (incomplete duality suggests missing abstractions)
• Reason about correctness (dual operations should satisfy dual laws)

1. Symmetry as a Design Principle: When designing systems, always ask "What's the dual of this operation?" If you can create, you should also be able to analyze. If you can combine, you should also be able to separate.

2. Context as a Fundamental Concept: The distinction between monadic (computational) and comonadic (spatial) contexts reveals two fundamental ways of thinking about context in programming. Both are necessary for complete systems.

3. Type Safety Through Exhaustiveness: Decidable patterns ensure that all possible input types are handled, providing compile-time guarantees about routing completeness.

4. Compositionality Through Duality: Forward and backward operations compose naturally, creating powerful building blocks for complex systems.

Finally, the universe is back in balance. And our programs are better for it.

Source code #

Reference implementation (opens in a new tab)

References

1. Newton's laws of motion (opens in a new tab) · Back
2. Curie's principle (opens in a new tab) · Back
3. Curie's Principle and spontaneous symmetry breaking (opens in a new tab)
4. Symmetry (opens in a new tab)
5. Opposite category (opens in a new tab)
6. Duality (mathematics) (opens in a new tab)
7. Dual (category theory) (opens in a new tab)

Continue exploring

• Introduction Same collection
• Category Category as a primary building block Same collection
• Domain & codomain Domain and codomain connection Same collection