{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}

module Text.XML.Prettify.Options where

import TextShow
import Prelude

-- | The indent size
type IndentSize = Int

-- | The indent style, either `Tab` or `Space` with a given indent size
data IndentStyle = TAB | SPACE IndentSize
  deriving stock (IndentStyle -> IndentStyle -> Bool
(IndentStyle -> IndentStyle -> Bool)
-> (IndentStyle -> IndentStyle -> Bool) -> Eq IndentStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndentStyle -> IndentStyle -> Bool
$c/= :: IndentStyle -> IndentStyle -> Bool
== :: IndentStyle -> IndentStyle -> Bool
$c== :: IndentStyle -> IndentStyle -> Bool
Eq, ReadPrec [IndentStyle]
ReadPrec IndentStyle
Int -> ReadS IndentStyle
ReadS [IndentStyle]
(Int -> ReadS IndentStyle)
-> ReadS [IndentStyle]
-> ReadPrec IndentStyle
-> ReadPrec [IndentStyle]
-> Read IndentStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IndentStyle]
$creadListPrec :: ReadPrec [IndentStyle]
readPrec :: ReadPrec IndentStyle
$creadPrec :: ReadPrec IndentStyle
readList :: ReadS [IndentStyle]
$creadList :: ReadS [IndentStyle]
readsPrec :: Int -> ReadS IndentStyle
$creadsPrec :: Int -> ReadS IndentStyle
Read, Int -> IndentStyle -> ShowS
[IndentStyle] -> ShowS
IndentStyle -> String
(Int -> IndentStyle -> ShowS)
-> (IndentStyle -> String)
-> ([IndentStyle] -> ShowS)
-> Show IndentStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndentStyle] -> ShowS
$cshowList :: [IndentStyle] -> ShowS
show :: IndentStyle -> String
$cshow :: IndentStyle -> String
showsPrec :: Int -> IndentStyle -> ShowS
$cshowsPrec :: Int -> IndentStyle -> ShowS
Show)

-- | The line break style:
-- Line Feed (LF), Carriage Return (CR),
-- or both (CRLF)
data EndOfLine = LF | CR | CRLF
  deriving stock (EndOfLine -> EndOfLine -> Bool
(EndOfLine -> EndOfLine -> Bool)
-> (EndOfLine -> EndOfLine -> Bool) -> Eq EndOfLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndOfLine -> EndOfLine -> Bool
$c/= :: EndOfLine -> EndOfLine -> Bool
== :: EndOfLine -> EndOfLine -> Bool
$c== :: EndOfLine -> EndOfLine -> Bool
Eq, ReadPrec [EndOfLine]
ReadPrec EndOfLine
Int -> ReadS EndOfLine
ReadS [EndOfLine]
(Int -> ReadS EndOfLine)
-> ReadS [EndOfLine]
-> ReadPrec EndOfLine
-> ReadPrec [EndOfLine]
-> Read EndOfLine
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EndOfLine]
$creadListPrec :: ReadPrec [EndOfLine]
readPrec :: ReadPrec EndOfLine
$creadPrec :: ReadPrec EndOfLine
readList :: ReadS [EndOfLine]
$creadList :: ReadS [EndOfLine]
readsPrec :: Int -> ReadS EndOfLine
$creadsPrec :: Int -> ReadS EndOfLine
Read, Int -> EndOfLine -> ShowS
[EndOfLine] -> ShowS
EndOfLine -> String
(Int -> EndOfLine -> ShowS)
-> (EndOfLine -> String)
-> ([EndOfLine] -> ShowS)
-> Show EndOfLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndOfLine] -> ShowS
$cshowList :: [EndOfLine] -> ShowS
show :: EndOfLine -> String
$cshow :: EndOfLine -> String
showsPrec :: Int -> EndOfLine -> ShowS
$cshowsPrec :: Int -> EndOfLine -> ShowS
Show)

-- | The options for the Prettify module
data PrettifyOpts = PrettifyOpts
  { -- | The indent style, either `Tab` or `Space` with a given indent size
    PrettifyOpts -> IndentStyle
indentStyle :: IndentStyle,
    -- | The line break style:
    -- Line Feed (LF), Carriage Return (CR),
    -- or both (CRLF)
    PrettifyOpts -> EndOfLine
endOfLine :: EndOfLine
  }

instance TextShow EndOfLine where
  showb :: EndOfLine -> Builder
showb EndOfLine
LF = Builder
"\n"
  showb EndOfLine
CR = Builder
"\r"
  showb EndOfLine
_ = (EndOfLine -> Builder) -> [EndOfLine] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap EndOfLine -> Builder
forall a. TextShow a => a -> Builder
showb [EndOfLine
CR, EndOfLine
LF]

instance TextShow IndentStyle where
  showb :: IndentStyle -> Builder
showb IndentStyle
TAB = Builder
"\t"
  showb (SPACE Int
indentSize) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate Int
indentSize Builder
showbSpace