{-# LANGUAGE OverloadedStrings #-}
module Deontic.Civil.Render
  ( KoreanRenderer(..)
  , OutputFormat(..)
  , Block(..)
  , Inline(..)
  , renderBlocks
  ) where

import Data.Text (Text)
import qualified Data.Text as T
import Deontic.Core.Types (ArticleRef(..))
import Deontic.Core.Verdict
import Deontic.Core.Adjudicate (Judgment(..))
import Deontic.Render

data OutputFormat = PlainText | Markdown
  deriving (OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
/= :: OutputFormat -> OutputFormat -> Bool
Eq, Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputFormat -> ShowS
showsPrec :: Int -> OutputFormat -> ShowS
$cshow :: OutputFormat -> String
show :: OutputFormat -> String
$cshowList :: [OutputFormat] -> ShowS
showList :: [OutputFormat] -> ShowS
Show)

-- | Inline text elements.
data Inline
  = Plain Text       -- ^ Unformatted text
  | Italic Inline    -- ^ Italic (emphasis)
  | Bold Inline      -- ^ Bold (strong emphasis)
  | Code Text        -- ^ Inline code
  | Seq [Inline]     -- ^ Sequence of inlines
  deriving (Inline -> Inline -> Bool
(Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool) -> Eq Inline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
/= :: Inline -> Inline -> Bool
Eq, Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
(Int -> Inline -> ShowS)
-> (Inline -> String) -> ([Inline] -> ShowS) -> Show Inline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inline -> ShowS
showsPrec :: Int -> Inline -> ShowS
$cshow :: Inline -> String
show :: Inline -> String
$cshowList :: [Inline] -> ShowS
showList :: [Inline] -> ShowS
Show)

-- | Block-level document elements.
data Block
  = Heading Int Inline  -- ^ Heading with level (e.g. 4 → ####)
  | Para Inline         -- ^ Paragraph
  | Blank               -- ^ Empty line
  deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show)

-- | Render blocks to text in the given output format.
renderBlocks :: OutputFormat -> [Block] -> Text
renderBlocks :: OutputFormat -> [Block] -> Text
renderBlocks OutputFormat
fmt = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Block] -> [Text]) -> [Block] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [Text]) -> [Block] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (OutputFormat -> Block -> [Text]
renderBlock OutputFormat
fmt)
  where
    renderBlock :: OutputFormat -> Block -> [Text]
renderBlock OutputFormat
PlainText (Heading Int
_ Inline
i) = [OutputFormat -> Inline -> Text
renderInline OutputFormat
PlainText Inline
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"]
    renderBlock OutputFormat
Markdown  (Heading Int
n Inline
i) = [Int -> Text -> Text
T.replicate Int
n Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputFormat -> Inline -> Text
renderInline OutputFormat
Markdown Inline
i]
    renderBlock OutputFormat
f         (Para Inline
i)      = [OutputFormat -> Inline -> Text
renderInline OutputFormat
f Inline
i]
    renderBlock OutputFormat
_         Block
Blank         = [Text
""]

-- | Render inline elements to text.
renderInline :: OutputFormat -> Inline -> Text
renderInline :: OutputFormat -> Inline -> Text
renderInline OutputFormat
_         (Plain Text
t)  = Text
t
renderInline OutputFormat
PlainText (Italic Inline
i) = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputFormat -> Inline -> Text
renderInline OutputFormat
PlainText Inline
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
renderInline OutputFormat
Markdown  (Italic Inline
i) = Text
"*\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputFormat -> Inline -> Text
renderInline OutputFormat
Markdown Inline
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"*"
renderInline OutputFormat
PlainText (Bold Inline
i)   = OutputFormat -> Inline -> Text
renderInline OutputFormat
PlainText Inline
i
renderInline OutputFormat
Markdown  (Bold Inline
i)   = Text
"**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputFormat -> Inline -> Text
renderInline OutputFormat
Markdown Inline
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**"
renderInline OutputFormat
_         (Code Text
t)   = Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
renderInline OutputFormat
fmt       (Seq [Inline]
is)   = [Text] -> Text
T.concat ((Inline -> Text) -> [Inline] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (OutputFormat -> Inline -> Text
renderInline OutputFormat
fmt) [Inline]
is)

-- | Smart constructors
plain :: Text -> Inline
plain :: Text -> Inline
plain = Text -> Inline
Plain

italic :: Text -> Inline
italic :: Text -> Inline
italic = Inline -> Inline
Italic (Inline -> Inline) -> (Text -> Inline) -> Text -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
Plain

data KoreanRenderer = KoreanRenderer
  { KoreanRenderer -> OutputFormat
rendererFormat :: OutputFormat
  }

instance Renderer KoreanRenderer where
  renderJudgment :: forall (layers :: [*]). KoreanRenderer -> Judgment layers -> Text
renderJudgment KoreanRenderer
r Judgment layers
j =
    let fmt :: OutputFormat
fmt = KoreanRenderer -> OutputFormat
rendererFormat KoreanRenderer
r
    in OutputFormat -> [Block] -> Text
renderBlocks OutputFormat
fmt (Judgment layers -> [Block]
forall (layers :: [*]). Judgment layers -> [Block]
judgmentBlocks Judgment layers
j)

-- | Build structured blocks from a judgment.
judgmentBlocks :: Judgment layers -> [Block]
judgmentBlocks :: forall (layers :: [*]). Judgment layers -> [Block]
judgmentBlocks Judgment layers
j =
  let steps :: [Step]
steps = Judgment layers -> [Step]
forall (layers :: [*]). Judgment layers -> [Step]
judgmentSteps Judgment layers
j
      v :: Verdict
v = case [Step]
steps of
            [] -> Verdict
Valid
            [Step]
_  -> Step -> Verdict
stepVerdict ([Step] -> Step
forall a. HasCallStack => [a] -> a
last [Step]
steps)
  in [ Int -> Inline -> Block
Heading Int
4 (Text -> Inline
plain Text
"판단")
     , Inline -> Block
Para (Text -> Inline
plain (Verdict -> Text
verdictText Verdict
v))
     , Block
Blank
     ]
     [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ (Step -> [Block]) -> [Step] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Step -> [Block]
stepBlocks [Step]
steps
     [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [ Inline -> Block
Para (Text -> Inline
plain (Text
"따라서, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Verdict -> Text
verdictText Verdict
v)) ]

stepBlocks :: Step -> [Block]
stepBlocks :: Step -> [Block]
stepBlocks Step
s =
  [ Int -> Inline -> Block
Heading Int
4 (Text -> Inline
plain (StepKind -> Text
kindLabel (Step -> StepKind
stepKind Step
s)))
  , Inline -> Block
Para (Text -> Inline
plain (ArticleRef -> Text
articleRefText (Step -> ArticleRef
stepArticle Step
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StepKind -> Text
kindSuffix (Step -> StepKind
stepKind Step
s)))
  , Inline -> Block
Para (Inline -> Inline
Italic (Text -> Inline
plain (Step -> Text
stepSourceText Step
s)))
  , Block
Blank
  ]

-- | Human-readable label for each step kind
kindLabel :: StepKind -> Text
kindLabel :: StepKind -> Text
kindLabel StepKind
Applied        = Text
"근거"
kindLabel StepKind
Overridden     = Text
"번복"
kindLabel StepKind
Delegated      = Text
"검토"
kindLabel StepKind
Counterfactual = Text
"의제"

-- | Suffix appended to article reference
kindSuffix :: StepKind -> Text
kindSuffix :: StepKind -> Text
kindSuffix StepKind
Applied        = Text
"에 의하면,"
kindSuffix StepKind
Overridden     = Text
"에 의하여,"
kindSuffix StepKind
Delegated      = Text
"을 검토하였으나 해당 없어,"
kindSuffix StepKind
Counterfactual = Text
"에 의하여 의제하면,"

verdictText :: Verdict -> Text
verdictText :: Verdict -> Text
verdictText Verdict
Valid    = Text
"본 법률행위는 유효하다."
verdictText Verdict
Void     = Text
"본 법률행위는 무효이다."
verdictText Verdict
Voidable = Text
"본 법률행위는 취소할 수 있다."
verdictText Verdict
Pending  = Text
"본 법률행위의 효력은 미정이다."

articleRefText :: ArticleRef -> Text
articleRefText :: ArticleRef -> Text
articleRefText ArticleRef
ref =
  Text
"민법 제" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (ArticleRef -> Int
articleNumber ArticleRef
ref)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"조"
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Int
p -> Text
" 제" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"항") (ArticleRef -> Maybe Int
articleParagraph ArticleRef
ref)