{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use record patterns" #-}
module Text.BBCode.Internal.Pretty
  ( pretty
  )
where

import Text.BBCode.Internal.Helper

{- ORMOLU_DISABLE -}

{- | Serialize BBCode AST

Parsing @'pretty' x@ should give you @x@, but currently that rarely works mostly
because of whitespaces. Whitespaces are appended when prettifying, but not
stripped when parsing. This leads to redundant whitespaces in parsed AST

Can cause error at runtime if unrepresentable element is passed

>>> pretty $ ElSimple HR "abc"
Prelude.undefined
-}
pretty :: BBCode -> Text
pretty (ElText x) = x
pretty (ElDocument xs) = mconcat $ fmap pretty xs

pretty (ElVoid HR) = opening HR <> "\n"
pretty (ElVoid BR) = opening BR <> "\n"
pretty (ElVoid Clear) = opening Clear <> "\n"
pretty (ElVoid ListElement) = "\n" <> opening ListElement
pretty (ElVoid _) = undefined

pretty (ElSimple Bold bb) = wrap Bold $ pretty bb
pretty (ElSimple Italic bb) = wrap Italic $ pretty bb
pretty (ElSimple Underline bb) = wrap Underline $ pretty bb
pretty (ElSimple Strikethrough bb) = wrap Strikethrough $ pretty bb
pretty (ElSimple Indent bb) = wrap Indent $ pretty bb
pretty (ElSimple NFO bb) = wrap NFO $ pretty bb
pretty (ElSimple Oneline bb) = wrap Oneline $ pretty bb
pretty (ElSimple Code bb) =
  wrap Code
    . surround "\n"
    $ pretty bb
pretty (ElSimple Preformatted bb) =
  wrap Preformatted
    . surround "\n"
    $ pretty bb

pretty (ElSimple Box bb) = wrap Box $ pretty bb
pretty (ElSimple Image bb) = wrap Image $ pretty bb
pretty (ElSimple Quote bb) = wrap Quote . surround "\n" $ pretty bb
pretty (ElSimple Spoiler bb) = wrap Spoiler . surround "\n" $ pretty bb
pretty (ElSimple List (ElDocument bb)) =
  wrap List
    . (<> "\n")
    . foldl (<>) ""
    $ fmap pretty bb
pretty (ElSimple _ _) = undefined

pretty (ElArg Box arg bb) = wrapArg Box arg $ pretty bb
pretty (ElArg Image arg bb) = wrapArg Image arg $ pretty bb
pretty (ElArg Quote arg bb) =
  wrapArg Quote (mconcat ["\"", arg, "\""])
    . surround "\n"
    $ pretty bb
pretty (ElArg Spoiler arg bb) =
  wrapArg Spoiler (mconcat ["\"", arg, "\""])
    . surround "\n"
    $ pretty bb
pretty (ElArg List arg (ElDocument bb)) =
  wrapArg List arg
    . (<> "\n")
    . foldl (<>) ""
    $ fmap pretty bb

pretty (ElArg Color arg bb) = wrapArg Color arg $ pretty bb
pretty (ElArg URL arg bb) = wrapArg URL arg $ pretty bb
pretty (ElArg Size arg bb) = wrapArg Size arg $ pretty bb
pretty (ElArg Align arg bb) = wrapArg Align arg $ pretty bb
pretty (ElArg Font arg bb) = wrapArg Font arg $ pretty bb
pretty (ElArg _ _ _) = undefined
{-# INLINEANBLE pretty #-}
{- ORMOLU_ENABLE -}