{-
    BNF Converter: XML generator
    Copyright (C) 2004  Author:  Aarne Ranta

-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module BNFC.Backend.XML ---- (cf2DTD, cf2XML)
  where

import Prelude hiding ((<>))

import Data.Bifunctor ( second )
import Data.List      ( intercalate )

import BNFC.CF
import BNFC.PrettyPrint
import BNFC.Utils
import BNFC.Backend.Base (Backend, mkfile)
import BNFC.Options (SharedOptions(..), pattern TargetHaskellGadt)
import BNFC.Backend.Haskell.CFtoTemplate ()
import BNFC.Backend.Haskell.HsOpts ( xmlFile, xmlFileM, absFileM )
import BNFC.Backend.Haskell.Utils  ( catToVar )
import qualified BNFC.Backend.Haskell.Utils as Haskell

type Coding = Bool ---- change to at least three values

makeXML :: SharedOptions -> Coding -> CF -> Backend
makeXML :: SharedOptions -> Coding -> CF -> Backend
makeXML SharedOptions
opts Coding
typ CF
cf = do
  let name :: String
name = SharedOptions -> String
lang SharedOptions
opts
  String -> MakeComment -> String -> Backend
forall c. FileContent c => String -> MakeComment -> c -> Backend
mkfile (String
name String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
".dtd") MakeComment
comment (String -> Backend) -> String -> Backend
forall a b. (a -> b) -> a -> b
$ Coding -> String -> CF -> String
cf2DTD Coding
typ String
name CF
cf
  let absmod :: String
absmod = String
"XML" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
name
  String -> MakeComment -> String -> Backend
forall c. FileContent c => String -> MakeComment -> c -> Backend
mkfile (SharedOptions -> String
xmlFile SharedOptions
opts) MakeComment
Haskell.comment (String -> Backend) -> String -> Backend
forall a b. (a -> b) -> a -> b
$ Coding -> SharedOptions -> String -> CF -> String
cf2XMLPrinter Coding
typ SharedOptions
opts String
absmod CF
cf

-- derive a DTD from a BNF grammar. AR 21/8/2004
cf2DTD :: Coding -> String -> CF -> String
cf2DTD :: Coding -> String -> CF -> String
cf2DTD Coding
typ String
name CF
cf = [String] -> String
unlines [
  MakeComment
tag String
"?xml version=\"1.0\" standalone=\"yes\"?",
  String
"<!DOCTYPE " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
name String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
" [",
  MakeComment
elemEmp String
"Integer",
  MakeComment
elemEmp String
"Double",
  MakeComment
elemEmp String
"String",
  if CF -> Coding
forall f. CFG f -> Coding
hasIdent CF
cf then MakeComment
elemEmp String
"Ident" else String
"",
  [String] -> String
unlines [MakeComment
elemEmp String
own | String
own <- CF -> [String]
forall f. CFG f -> [String]
tokenNames CF
cf],
  [String] -> String
unlines (((Cat, [(String, [Cat])]) -> String)
-> [(Cat, [(String, [Cat])])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Coding -> CF -> (Cat, [(String, [Cat])]) -> String
elemData Coding
typ CF
cf) (CF -> [(Cat, [(String, [Cat])])]
cf2data CF
cf)),
  String
"]>"
  ]

comment :: String -> String
comment :: MakeComment
comment String
x = [String] -> String
unwords [ String
"<!--", String
x, String
"-->" ]

-- | >>> tag "test"
-- "<test>"
tag :: String -> String
tag :: MakeComment
tag String
s = String
"<" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
s String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
">"

element :: String -> [String] -> String
element :: String -> [String] -> String
element String
t [String]
ts =
  MakeComment
tag (String
"!ELEMENT " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
t String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
" " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ [String] -> String
alts [String]
ts)

attlist :: String -> MakeComment
attlist String
t String
a =
  MakeComment
tag (String
"!ATTLIST " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
t String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
" " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
a String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
" CDATA #REQUIRED")
elemAtt :: String -> String -> [String] -> String
elemAtt String
t String
a [String]
ts = String -> [String] -> String
element String
t [String]
ts String -> MakeComment
++++ String -> MakeComment
attlist String
t String
a
elemt :: String -> [String] -> String
elemt String
t = String -> String -> [String] -> String
elemAtt String
t String
"name"

elemc :: Cat -> [(Fun, String)] -> String
elemc :: Cat -> [(String, String)] -> String
elemc Cat
cat [(String, String)]
fs = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
element (Cat -> String
forall a. Pretty a => a -> String
prettyShow Cat
cat) (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
fs) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String -> [String] -> String
element String
f [] | (String
f,String
_) <- [(String, String)]
fs]

elemEmp :: String -> String
elemEmp :: MakeComment
elemEmp String
t = String -> String -> [String] -> String
elemAtt String
t String
"value" []

alts :: [String] -> String
alts :: [String] -> String
alts [String]
ts = if [String] -> Coding
forall (t :: * -> *) a. Foldable t => t a -> Coding
null [String]
ts then String
"EMPTY" else MakeComment
parenth MakeComment -> MakeComment
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" | " [String]
ts

-- choose between these two encodings:

elemData :: Coding -> CF -> (Cat, [(String, [Cat])]) -> String
elemData Coding
b  = if Coding
b then CF -> (Cat, [(String, [Cat])]) -> String
elemDataConstr else CF -> (Cat, [(String, [Cat])]) -> String
forall a. CF -> (a, [(String, [Cat])]) -> String
elemDataNotyp
efunDef :: Coding -> String
efunDef Coding
b   = if Coding
b then String
efunDefConstr else String
efunDefNotyp
endtagDef :: Coding -> String
endtagDef Coding
b = if Coding
b then String
endtagDefConstr else String
endtagDefNotyp

-- coding 0: ---- not finished
-- to show both types and constructors as tags;
-- lengthy, but validation guarantees type correctness
-- flag -xmlt
elemDataConstrs :: CF -> (Cat, [(String, [Cat])]) -> String
elemDataConstrs CF
cf (Cat
cat,[(String, [Cat])]
fcs) = Cat -> [(String, String)] -> String
elemc Cat
cat [(String
f,CF -> String -> [Cat] -> String
rhsCat CF
cf String
f [Cat]
cs) | (String
f,[Cat]
cs) <- [(String, [Cat])]
fcs]

efunDefConstrs :: String
efunDefConstrs :: String
efunDefConstrs = String
"elemFun i t x = [P.replicate (i+i) ' ' ++ tag t ++ \" \" ++ etag x]"

endtagDefConstrs :: String
endtagDefConstrs :: String
endtagDefConstrs = String
"endtag _ c = tag (\"/\" ++ c)"

-- coding 1:
-- to show constructors as empty tags;
-- shorter than 0, but validation still guarantees type correctness
-- flag -xmlt
elemDataConstr :: CF -> (Cat, [(String, [Cat])]) -> String
elemDataConstr CF
cf (Cat
cat,[(String, [Cat])]
fcs) = Cat -> [(String, String)] -> String
elemc Cat
cat [(String
f,CF -> String -> [Cat] -> String
rhsCat CF
cf String
f [Cat]
cs) | (String
f,[Cat]
cs) <- [(String, [Cat])]
fcs]
efunDefConstr :: String
efunDefConstr = String
"elemFun i t x = [P.replicate (i+i) ' ' ++ tag t ++ \" \" ++ etag x]"
endtagDefConstr :: String
endtagDefConstr = String
"endtag _ c = tag (\"/\" ++ c)"

-- coding 2:
-- constructors as tags, no types.
-- clumsy DTD, but nice trees. Validation guarantees type correctness
-- flag -xml
elemDataNotyp :: CF -> (a, [(String, [Cat])]) -> String
elemDataNotyp CF
cf (a
_,[(String, [Cat])]
fcs) = [String] -> String
unlines [String -> [String] -> String
element String
f [CF -> [Cat] -> String
rhsCatNot CF
cf [Cat]
cs] | (String
f,[Cat]
cs) <- [(String, [Cat])]
fcs]
efunDefNotyp :: String
efunDefNotyp = String
"elemFun i _ x = [P.replicate (i+i) ' ' ++ tag x]"
endtagDefNotyp :: String
endtagDefNotyp = String
"endtag f _ = tag (\"/\" ++ f)"


-- to show constructors as attributes;
-- nice, but validation does not guarantee type correctness.
-- Therefore rejected.
-- elemDataAttr cf (cat,fcs) = elemt cat (nub [rhsCat cf cs | (_,cs) <- fcs])
-- efunDefAttr =  "elemFun i t x = [replicate (i+i) ' ' ++ tag (t ++ \" name = \" ++ x)]"

rhsCat :: CF -> Fun -> [Cat] -> String
rhsCat :: CF -> String -> [Cat] -> String
rhsCat CF
cf String
fun [Cat]
cs = MakeComment
parenth (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (String
fun String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> String
render (Doc -> String) -> (Cat -> Doc) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CF -> Cat -> Doc
symbCat CF
cf) [Cat]
cs))
rhsCatNot :: CF -> [Cat] -> String
rhsCatNot CF
cf [Cat]
cs = if [Cat] -> Coding
forall (t :: * -> *) a. Foldable t => t a -> Coding
null [Cat]
cs then String
"EMPTY" else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> String
render (Doc -> String) -> (Cat -> Doc) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CF -> Cat -> Doc
symbCatNot CF
cf) [Cat]
cs)

symbCat :: CF -> Cat -> Doc
symbCat :: CF -> Cat -> Doc
symbCat CF
cf Cat
c
  | Cat -> Coding
isList Cat
c  = Cat -> Doc
forall a. Pretty a => a -> Doc
pretty (Cat -> Cat
normCatOfList Cat
c) Doc -> Doc -> Doc
<> if CF -> Cat -> Coding
isEmptyListCat CF
cf Cat
c then Doc
"*" else Doc
"+"
  | Coding
otherwise = Cat -> Doc
forall a. Pretty a => a -> Doc
pretty Cat
c

symbCatNot :: CF -> Cat -> Doc
symbCatNot :: CF -> Cat -> Doc
symbCatNot CF
cf Cat
c
  | Cat -> Coding
isList Cat
c  = Cat -> Doc
funs (Cat -> Cat
normCatOfList Cat
c) Doc -> Doc -> Doc
<> if CF -> Cat -> Coding
isEmptyListCat CF
cf Cat
c then Doc
"*" else Doc
"+"
  | Coding
otherwise = Cat -> Doc
funs Cat
c
 where
   funs :: Cat -> Doc
funs Cat
k =
     case Cat -> [(Cat, [(String, [Cat])])] -> Maybe [(String, [Cat])]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Cat
k (CF -> [(Cat, [(String, [Cat])])]
cf2data CF
cf) of
       Just []  -> Doc
"EMPTY"
       Just [(String, [Cat])]
fcs -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
"|" ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((String, [Cat]) -> Doc) -> [(String, [Cat])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc)
-> ((String, [Cat]) -> String) -> (String, [Cat]) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [Cat]) -> String
forall a b. (a, b) -> a
fst) [(String, [Cat])]
fcs
       Maybe [(String, [Cat])]
_        -> Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Cat -> Doc
forall a. Pretty a => a -> Doc
pretty Cat
k

parenth :: MakeComment
parenth String
s = String
"(" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
s String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
")"

-- derive an XML printer from a BNF grammar
cf2XMLPrinter :: Bool -> SharedOptions -> String -> CF -> String
cf2XMLPrinter :: Coding -> SharedOptions -> String -> CF -> String
cf2XMLPrinter Coding
typ SharedOptions
opts String
absMod CF
cf = [String] -> String
unlines [
  String
"{-# LANGUAGE LambdaCase #-}",
  SharedOptions -> String
pragmas SharedOptions
opts,
  Coding -> SharedOptions -> MakeComment
prologue Coding
typ SharedOptions
opts String
absMod,
  CF -> String
forall p. p -> String
integerRule CF
cf,
  CF -> String
forall p. p -> String
doubleRule CF
cf,
  CF -> String
forall p. p -> String
stringRule CF
cf,
  if CF -> Coding
forall f. CFG f -> Coding
hasIdent CF
cf then CF -> String
identRule CF
cf else String
"",
  [String] -> String
unlines [CF -> MakeComment
ownPrintRule CF
cf String
own | (String
own,Reg
_) <- CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf],
  CF -> String
rules CF
cf
  ]

pragmas :: SharedOptions -> String
pragmas :: SharedOptions -> String
pragmas SharedOptions
opts =
  if SharedOptions -> Target
target SharedOptions
opts Target -> Target -> Coding
forall a. Eq a => a -> a -> Coding
== Target
TargetHaskellGadt
  then String
"{-# LANGUAGE FlexibleInstances, GADTs #-}"
  else String
""

prologue :: Bool -> SharedOptions -> String -> String
prologue :: Coding -> SharedOptions -> MakeComment
prologue Coding
b SharedOptions
opts String
_ = [String] -> String
unlines [
  String
"-- Pretty printing to XML",
  String
"",
  String
"module " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ SharedOptions -> String
xmlFileM SharedOptions
opts String -> MakeComment
+++ String
"where",
  String
"",
  String
"import Prelude",
  String
"  ( Char, Double, Integer, String",
  String
"  , (.), ($), (+), (++)",
  String
"  )",
  String
"import qualified Prelude as P",
  String
"  ( Show(..), Int",
  String
"  , concat, concatMap, replicate, unlines",
  String
"  )",
  String
"",
  String
"import " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ SharedOptions -> String
absFileM SharedOptions
opts,
  String
"",
  String
"-- the top-level printing method",
  String
"printXML :: XPrint a => a -> String",
  String
"printXML = render . prt 0",
  String
"",
  String
"render :: [String] -> String",
  String
"render = P.unlines",
  String
"",
  String
"-- the printer class does the job",
  String
"class XPrint a where",
  String
"  prt :: P.Int -> a -> [String]",
  String
"  prtList :: P.Int -> [a] -> [String]",
  String
"  prtList = P.concatMap . prt",
  String
"",
  String
"instance XPrint a => XPrint [a] where",
  String
"  prt = prtList",
  String
"",
  String
"tag, etag :: String -> String",
  String
"tag t = \"<\" ++ t ++ \">\"",
  String
"etag t = \"<\" ++ t ++ \"/>\"",
  String
"",
  String
"elemTok, elemTokS :: P.Show a => P.Int -> String -> a -> [String]",
  String
"elemTok i t x = [P.replicate (i+i) ' ' ++ tag (t ++ \" value = \" ++ P.show x ++ \" /\")]",
  String
"elemTokS i t x = elemTok i t (P.show x)",
  String
"",
  String
"elemFun :: P.Int -> String -> String -> [String]",
  Coding -> String
efunDef Coding
b,
  String
"",
  String
"endtag :: String -> String -> String",
  Coding -> String
endtagDef Coding
b,
  String
""
  ]

integerRule :: p -> String
integerRule p
cf = p -> MakeComment
forall p. p -> MakeComment
showsPrintRule p
cf String
"Integer"
doubleRule :: p -> String
doubleRule p
cf = p -> MakeComment
forall p. p -> MakeComment
showsPrintRule p
cf String
"Double"
stringRule :: p -> String
stringRule p
cf = p -> MakeComment
forall p. p -> MakeComment
showsPrintRule p
cf String
"Char" String -> MakeComment
++++ String
"  prtList i xs = elemTok i \"String\" xs"

showsPrintRule :: p -> MakeComment
showsPrintRule p
_ String
t = [String] -> String
unlines [
  String
"instance XPrint " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
t String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
" where",
  String
"  prt i x = elemTokS i" String -> MakeComment
+++ String
"\"" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
t String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> MakeComment
+++ String
"x"
  ]

identRule :: CF -> String
identRule CF
cf = CF -> MakeComment
ownPrintRule CF
cf String
catIdent

ownPrintRule :: CF -> TokenCat -> String
ownPrintRule :: CF -> MakeComment
ownPrintRule CF
cf String
cat = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  [ String
"instance XPrint " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
cat String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
" where"
  , String
"  prt i (" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
cat String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
posn String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
") = elemTok i" String -> MakeComment
+++ String
"\"" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
cat String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> MakeComment
+++ String
"x"
  ]
 where
   posn :: String
posn = if CF -> String -> Coding
forall f. CFG f -> String -> Coding
isPositionCat CF
cf String
cat then String
" (_,x)" else String
" x"

rules :: CF -> String
rules :: CF -> String
rules CF
cf = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  ((Cat, [(String, [Cat])]) -> String)
-> [(Cat, [(String, [Cat])])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Cat
s, [(String, [Cat])]
xs) -> Cat -> [(String, [String])] -> String
case_fun Cat
s (((String, [Cat]) -> (String, [String]))
-> [(String, [Cat])] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (([Cat] -> [String]) -> (String, [Cat]) -> (String, [String])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Cat] -> [String]
toArgs) [(String, [Cat])]
xs)) ([(Cat, [(String, [Cat])])] -> [String])
-> [(Cat, [(String, [Cat])])] -> [String]
forall a b. (a -> b) -> a -> b
$ CF -> [(Cat, [(String, [Cat])])]
cf2data CF
cf
 where
   toArgs :: [Cat] -> [String]
toArgs [Cat]
args = [String] -> Int -> [String]
forall t. (Show t, Num t) => [String] -> t -> [String]
names ((Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Cat -> String
catToVar [String
"prt"]) [Cat]
args) (Int
0 :: Int)
   names :: [String] -> t -> [String]
names [] t
_ = []
   names (String
x:[String]
xs) t
n
     | String
x String -> [String] -> Coding
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Coding
`elem` [String]
xs = (String
x String -> MakeComment
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
n) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> t -> [String]
names [String]
xs (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     | Coding
otherwise   = String
x             String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> t -> [String]
names [String]
xs t
n

case_fun :: Cat -> [(String, [String])] -> String
case_fun :: Cat -> [(String, [String])] -> String
case_fun Cat
cat [(String, [String])]
xs = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ String
"instance XPrint" String -> MakeComment
+++ String
s String -> MakeComment
+++ String
"where"
    , String
"  prt i'" String -> MakeComment
+++ String
"= \\case"
    ]
  , (((String, [String]) -> String) -> [(String, [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
`map` [(String, [String])]
xs) (((String, [String]) -> String) -> [String])
-> ((String, [String]) -> String) -> [String]
forall a b. (a -> b) -> a -> b
$ \ (String
c, [String]
xx) ->
    String
"   " String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
c String -> MakeComment
+++ [String] -> String
unwords [String]
xx String -> MakeComment
+++ String
"-> P.concat $ " String -> MakeComment
+++
    String
"elemFun i' \"" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
s String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
"\" \"" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
c String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
"\"" String -> MakeComment
+++
    [String] -> String
unwords [String
": prt (i'+1)" String -> MakeComment
+++ String
x | String
x <- [String]
xx] String -> MakeComment
+++ String
":" String -> MakeComment
+++
    String
"[[P.replicate (i'+i') ' ' ++ endtag \"" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
c String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
"\" \"" String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
s String -> MakeComment
forall a. [a] -> [a] -> [a]
++ String
"\"]]"
  ]
  where
  s :: String
s = Cat -> String
forall a. Pretty a => a -> String
prettyShow Cat
cat