module Deontic.BGB.Capacity () where

import qualified Data.Set as Set
import Deontic.Core.Types
import Deontic.Core.Verdict
import Deontic.Core.Layer (Base, Proviso, SpecialRule, Resolvable)
import Deontic.Core.Adjudicate
import Deontic.BGB.Types

-- ═══════════════════════════════════════════════
-- Geschäftsfähigkeit — Capacity (BGB §104-§113)
--
-- This demonstrates jurisdiction-agnosticism:
-- the same deontic-core framework encodes German law
-- with German-specific act types, facts, and articles.
--
-- Structure mirrors Korean MinorAct but with BGB semantics:
-- §104: Geschäftsunfähig (absolutely incapable) → Void
-- §106: Beschränkt geschäftsfähig (limited capacity) → Voidable
-- §107: Lediglich rechtlicher Vorteil → Valid (proviso)
-- §110: Taschengeldparagraph → Valid (special rule)
-- ═══════════════════════════════════════════════

type instance Resolvable CapacityAct = '[SpecialRule, Proviso, Base]

-- §104 Geschäftsunfähigkeit + §106 beschränkte Geschäftsfähigkeit
-- Base layer: check capacity status
instance Adjudicate CapacityAct '[Base] where
  adjudicate :: CapacityAct -> Facts CapacityAct -> Judgment '[Base]
adjudicate (CapacityAct PersonId
actor ActId
actId) Facts CapacityAct
facts
    -- §104: Geschäftsunfähig → Void (nichtig)
    | PersonId -> BGBFact
UnderSeven PersonId
actor BGBFact -> Set BGBFact -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BGBFact
Facts CapacityAct
facts =
        Verdict -> ArticleRef -> Text -> Judgment '[Base]
forall l. Verdict -> ArticleRef -> Text -> Judgment '[l]
JBase Verdict
Void
          (Text -> Int -> Maybe Int -> ArticleRef
ArticleRef Text
"BGB" Int
104 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1))
          Text
"Geschäftsunfähig ist, wer nicht das siebente Lebensjahr vollendet hat."
    | PersonId -> BGBFact
PermanentlyIncapable PersonId
actor BGBFact -> Set BGBFact -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BGBFact
Facts CapacityAct
facts =
        Verdict -> ArticleRef -> Text -> Judgment '[Base]
forall l. Verdict -> ArticleRef -> Text -> Judgment '[l]
JBase Verdict
Void
          (Text -> Int -> Maybe Int -> ArticleRef
ArticleRef Text
"BGB" Int
104 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2))
          Text
"Geschäftsunfähig ist, wer sich in einem die freie Willensbestimmung ausschließenden Zustand krankhafter Störung der Geistestätigkeit befindet."
    -- §106: beschränkt geschäftsfähig → Voidable (schwebend unwirksam)
    | PersonId -> BGBFact
IsMinor PersonId
actor BGBFact -> Set BGBFact -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BGBFact
Facts CapacityAct
facts
    , Bool -> Bool
not (PersonId -> ActId -> Set BGBFact -> Bool
hasConsent PersonId
actor ActId
actId Set BGBFact
Facts CapacityAct
facts) =
        Verdict -> ArticleRef -> Text -> Judgment '[Base]
forall l. Verdict -> ArticleRef -> Text -> Judgment '[l]
JBase Verdict
Voidable
          (Text -> Int -> Maybe Int -> ArticleRef
ArticleRef Text
"BGB" Int
106 Maybe Int
forall a. Maybe a
Nothing)
          Text
"Ein Minderjähriger, der das siebente Lebensjahr vollendet hat, ist in der Geschäftsfähigkeit beschränkt."
    -- Full capacity
    | Bool
otherwise =
        Verdict -> ArticleRef -> Text -> Judgment '[Base]
forall l. Verdict -> ArticleRef -> Text -> Judgment '[l]
JBase Verdict
Valid
          (Text -> Int -> Maybe Int -> ArticleRef
ArticleRef Text
"BGB" Int
104 Maybe Int
forall a. Maybe a
Nothing)
          Text
"Volle Geschäftsfähigkeit — die Willenserklärung ist wirksam."

-- §107 Lediglich rechtlicher Vorteil (purely beneficial)
instance Adjudicate CapacityAct rest
      => Adjudicate CapacityAct (Proviso ': rest) where
  adjudicate :: CapacityAct -> Facts CapacityAct -> Judgment (Proviso : rest)
adjudicate CapacityAct
act Facts CapacityAct
facts
    | BGBFact
PurelyBeneficial BGBFact -> Set BGBFact -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BGBFact
Facts CapacityAct
facts =
        Judgment rest
-> Verdict -> ArticleRef -> Text -> Judgment (Proviso : rest)
forall (prev :: [*]) l.
Judgment prev
-> Verdict -> ArticleRef -> Text -> Judgment (l : prev)
JOverride (forall act (layers :: [*]).
Adjudicate act layers =>
act -> Facts act -> Judgment layers
adjudicate @_ @rest CapacityAct
act Facts CapacityAct
facts)
                  Verdict
Valid
                  (Text -> Int -> Maybe Int -> ArticleRef
ArticleRef Text
"BGB" Int
107 Maybe Int
forall a. Maybe a
Nothing)
                  Text
"Der Minderjährige bedarf nicht der Zustimmung des gesetzlichen Vertreters, soweit er lediglich einen rechtlichen Vorteil erlangt."
    | Bool
otherwise =
        Judgment rest -> Judgment (Proviso : rest)
forall (prev :: [*]) l. Judgment prev -> Judgment (l : prev)
JDelegate (forall act (layers :: [*]).
Adjudicate act layers =>
act -> Facts act -> Judgment layers
adjudicate @_ @rest CapacityAct
act Facts CapacityAct
facts)

-- §110 Taschengeldparagraph (pocket money)
instance Adjudicate CapacityAct rest
      => Adjudicate CapacityAct (SpecialRule ': rest) where
  adjudicate :: CapacityAct -> Facts CapacityAct -> Judgment (SpecialRule : rest)
adjudicate CapacityAct
act Facts CapacityAct
facts
    | BGBFact
PocketMoney BGBFact -> Set BGBFact -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BGBFact
Facts CapacityAct
facts =
        Judgment rest
-> Verdict -> ArticleRef -> Text -> Judgment (SpecialRule : rest)
forall (prev :: [*]) l.
Judgment prev
-> Verdict -> ArticleRef -> Text -> Judgment (l : prev)
JOverride (forall act (layers :: [*]).
Adjudicate act layers =>
act -> Facts act -> Judgment layers
adjudicate @_ @rest CapacityAct
act Facts CapacityAct
facts)
                  Verdict
Valid
                  (Text -> Int -> Maybe Int -> ArticleRef
ArticleRef Text
"BGB" Int
110 Maybe Int
forall a. Maybe a
Nothing)
                  Text
"Ein von dem Minderjährigen ohne Zustimmung des gesetzlichen Vertreters geschlossener Vertrag gilt als von Anfang an wirksam, wenn der Minderjährige die vertragsmäßige Leistung mit Mitteln bewirkt, die ihm zu diesem Zweck oder zu freier Verfügung überlassen worden sind."
    | Bool
otherwise =
        Judgment rest -> Judgment (SpecialRule : rest)
forall (prev :: [*]) l. Judgment prev -> Judgment (l : prev)
JDelegate (forall act (layers :: [*]).
Adjudicate act layers =>
act -> Facts act -> Judgment layers
adjudicate @_ @rest CapacityAct
act Facts CapacityAct
facts)

hasConsent :: PersonId -> ActId -> Set.Set BGBFact -> Bool
hasConsent :: PersonId -> ActId -> Set BGBFact -> Bool
hasConsent PersonId
actor ActId
actId Set BGBFact
facts =
  PersonId -> ActId -> BGBFact
LegalRepConsent PersonId
actor ActId
actId BGBFact -> Set BGBFact -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BGBFact
facts