module Data.BAByNF.ABNF.PrettyPrint
    ( PrettyPrint
    , prettyPrint
    ) where

import Data.List qualified as List

import Data.ByteString.Char8 qualified as ByteString.Char8

import Data.BAByNF.ABNF.Model qualified as Model

class PrettyPrint a where
  prettyPrint :: a -> String

instance PrettyPrint Model.Rulelist where
  prettyPrint :: Rulelist -> String
prettyPrint (Model.Rulelist [Rule]
x) = (Rule -> String) -> [Rule] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\r\n") (String -> String) -> (Rule -> String) -> Rule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> String
forall a. PrettyPrint a => a -> String
prettyPrint) [Rule]
x

instance PrettyPrint Model.Rule where
  prettyPrint :: Rule -> String
prettyPrint (Model.Rule Rulename
rulename DefinedAs
definedAs Elements
elements) = Rulename -> String
forall a. PrettyPrint a => a -> String
prettyPrint Rulename
rulename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DefinedAs -> String
forall a. PrettyPrint a => a -> String
prettyPrint DefinedAs
definedAs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Elements -> String
forall a. PrettyPrint a => a -> String
prettyPrint Elements
elements

instance PrettyPrint Model.Rulename where
  prettyPrint :: Rulename -> String
prettyPrint (Model.Rulename ByteString
x) = ByteString -> String
ByteString.Char8.unpack ByteString
x

instance PrettyPrint Model.DefinedAs where
  prettyPrint :: DefinedAs -> String
prettyPrint DefinedAs
Model.BasicDefinition = String
"="
  prettyPrint DefinedAs
Model.IncrementalAlternative = String
"=/"

instance PrettyPrint Model.Elements where
  prettyPrint :: Elements -> String
prettyPrint (Model.Elements Alternation
a) = Alternation -> String
forall a. PrettyPrint a => a -> String
prettyPrint Alternation
a

instance PrettyPrint Model.Alternation where
  prettyPrint :: Alternation -> String
prettyPrint (Model.Alternation [Concatenation]
x) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
" / " ((Concatenation -> String) -> [Concatenation] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Concatenation -> String
forall a. PrettyPrint a => a -> String
prettyPrint [Concatenation]
x)

instance PrettyPrint Model.Concatenation where
  prettyPrint :: Concatenation -> String
prettyPrint (Model.Concatenation [Repetition]
x) = [String] -> String
unwords ((Repetition -> String) -> [Repetition] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Repetition -> String
forall a. PrettyPrint a => a -> String
prettyPrint [Repetition]
x)

instance PrettyPrint Model.Repetition where
  prettyPrint :: Repetition -> String
prettyPrint (Model.Repetition Repeat
r Element
e) = Repeat -> String
forall a. PrettyPrint a => a -> String
prettyPrint Repeat
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. PrettyPrint a => a -> String
prettyPrint Element
e

instance PrettyPrint Model.Repeat where
  prettyPrint :: Repeat -> String
prettyPrint Repeat
Model.NoRepeat = String
""
  prettyPrint (Model.FixedRepeat Integer
i) = Integer -> String
forall a. Show a => a -> String
show Integer
i
  prettyPrint (Model.RangedRepeat Bound
mn Bound
mx) = Bound -> String
toString Bound
mn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bound -> String
toString Bound
mx
    where toString :: Bound -> String
toString Bound
Model.UnBound = String
""
          toString (Model.FixedBound Integer
i) = Integer -> String
forall a. Show a => a -> String
show Integer
i

instance PrettyPrint Model.Element where
  prettyPrint :: Element -> String
prettyPrint (Model.RulenameElement Rulename
x) = Rulename -> String
forall a. PrettyPrint a => a -> String
prettyPrint Rulename
x
  prettyPrint (Model.GroupElement Group
x) = Group -> String
forall a. PrettyPrint a => a -> String
prettyPrint Group
x
  prettyPrint (Model.OptionElement Option
x) = Option -> String
forall a. PrettyPrint a => a -> String
prettyPrint Option
x
  prettyPrint (Model.NumValElement NumVal
x) = NumVal -> String
forall a. PrettyPrint a => a -> String
prettyPrint NumVal
x
  prettyPrint (Model.CharValElement CharVal
x) = CharVal -> String
forall a. PrettyPrint a => a -> String
prettyPrint CharVal
x
  prettyPrint (Model.ProseValElement ProseVal
x) = ProseVal -> String
forall a. PrettyPrint a => a -> String
prettyPrint ProseVal
x

instance PrettyPrint Model.Group where
  prettyPrint :: Group -> String
prettyPrint (Model.Group Alternation
x) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Alternation -> String
forall a. PrettyPrint a => a -> String
prettyPrint Alternation
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance PrettyPrint Model.Option where
  prettyPrint :: Option -> String
prettyPrint (Model.Option Alternation
x) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Alternation -> String
forall a. PrettyPrint a => a -> String
prettyPrint Alternation
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

instance PrettyPrint Model.NumVal where
  prettyPrint :: NumVal -> String
prettyPrint NumVal
x = String
"%" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    ( case NumVal
x of
      Model.BinNumVal BinVal
y -> BinVal -> String
forall a. PrettyPrint a => a -> String
prettyPrint BinVal
y
      Model.DecNumVal DecVal
y -> DecVal -> String
forall a. PrettyPrint a => a -> String
prettyPrint DecVal
y
      Model.HexNumVal HexVal
y -> HexVal -> String
forall a. PrettyPrint a => a -> String
prettyPrint HexVal
y
    )

instance PrettyPrint Model.BinVal where
  prettyPrint :: BinVal -> String
prettyPrint BinVal
x = String
"b" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    (case BinVal
x of
      Model.SeqBinVal [Seq]
y -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." ((Seq -> String) -> [Seq] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Seq -> String
forall a. Show a => a -> String
show [Seq]
y)
      Model.RangeBinVal Seq
y Seq
z -> Seq -> String
forall a. Show a => a -> String
show Seq
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seq -> String
forall a. Show a => a -> String
show Seq
z
    )

instance PrettyPrint Model.DecVal where
  prettyPrint :: DecVal -> String
prettyPrint DecVal
x = String
"d" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    (case DecVal
x of
      Model.SeqDecVal [Seq]
y -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." ((Seq -> String) -> [Seq] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Seq -> String
forall a. Show a => a -> String
show [Seq]
y)
      Model.RangeDecVal Seq
y Seq
z -> Seq -> String
forall a. Show a => a -> String
show Seq
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seq -> String
forall a. Show a => a -> String
show Seq
z
    )

instance PrettyPrint Model.HexVal where
  prettyPrint :: HexVal -> String
prettyPrint HexVal
x = String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    (case HexVal
x of
      Model.SeqHexVal [Seq]
y -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." ((Seq -> String) -> [Seq] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Seq -> String
forall a. Show a => a -> String
show [Seq]
y)
      Model.RangeHexVal Seq
y Seq
z -> Seq -> String
forall a. Show a => a -> String
show Seq
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seq -> String
forall a. Show a => a -> String
show Seq
z
    )

instance PrettyPrint Model.CharVal where
  prettyPrint :: CharVal -> String
prettyPrint (Model.CaseInsensitiveCharVal CaseInsensitiveString
x) = CaseInsensitiveString -> String
forall a. PrettyPrint a => a -> String
prettyPrint CaseInsensitiveString
x
  prettyPrint (Model.CaseSensitiveCharVal CaseSensitiveString
x) = CaseSensitiveString -> String
forall a. PrettyPrint a => a -> String
prettyPrint CaseSensitiveString
x

instance PrettyPrint Model.CaseInsensitiveString where
  prettyPrint :: CaseInsensitiveString -> String
prettyPrint (Model.CaseInsensitiveString QuotedString
x) = QuotedString -> String
forall a. PrettyPrint a => a -> String
prettyPrint QuotedString
x

instance PrettyPrint Model.CaseSensitiveString where
  prettyPrint :: CaseSensitiveString -> String
prettyPrint (Model.CaseSensitiveString QuotedString
x) = String
"%s" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QuotedString -> String
forall a. PrettyPrint a => a -> String
prettyPrint QuotedString
x

instance PrettyPrint Model.QuotedString where
  prettyPrint :: QuotedString -> String
prettyPrint (Model.QuotedString ByteString
b) = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
ByteString.Char8.unpack ByteString
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

instance PrettyPrint Model.ProseVal where
  prettyPrint :: ProseVal -> String
prettyPrint (Model.ProseVal ByteString
b) = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
ByteString.Char8.unpack ByteString
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"