module Data.DTA.PrettyPrint (sToDTA) where
import qualified Data.ByteString.Char8 as B8
import Data.Char (isAlphaNum)
import qualified Text.PrettyPrint.HughesPJ as PP
import Data.DTA.Base
ppChunk :: Chunk -> PP.Doc
ppChunk :: Chunk -> Doc
ppChunk Chunk
c = case Chunk
c of
Int Int32
i -> String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int32 -> String
forall a. Show a => a -> String
show Int32
i
Float Float
f -> String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
f
Var ByteString
t -> [Doc] -> Doc
PP.hcat [Char -> Doc
PP.char Char
'$', ByteString -> Doc
ppText ByteString
t]
Sym ByteString
t -> String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
ppSym (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B8.unpack ByteString
t
Chunk
Unhandled -> String -> Doc
PP.text String
"kDataUnhandled"
IfDef ByteString
t -> [Doc] -> Doc
PP.hsep [String -> Doc
PP.text String
"#ifdef", ByteString -> Doc
ppText ByteString
t]
Chunk
Else -> String -> Doc
PP.text String
"#else"
Chunk
EndIf -> String -> Doc
PP.text String
"#endif"
Parens Tree
tr -> Doc -> Doc
PP.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Tree -> Doc
ppTree Tree
tr
Braces Tree
tr -> Doc -> Doc
PP.braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Tree -> Doc
ppTree Tree
tr
String ByteString
t -> String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
doubleQuotedString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B8.unpack ByteString
t
Brackets Tree
tr -> Doc -> Doc
PP.brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Tree -> Doc
ppTree Tree
tr
Define ByteString
t -> [Doc] -> Doc
PP.hsep [String -> Doc
PP.text String
"#define", ByteString -> Doc
ppText ByteString
t]
Include ByteString
t -> [Doc] -> Doc
PP.hsep [String -> Doc
PP.text String
"#include", ByteString -> Doc
ppText ByteString
t]
Merge ByteString
t -> [Doc] -> Doc
PP.hsep [String -> Doc
PP.text String
"#merge", ByteString -> Doc
ppText ByteString
t]
IfNDef ByteString
t -> [Doc] -> Doc
PP.hsep [String -> Doc
PP.text String
"#ifndef", ByteString -> Doc
ppText ByteString
t]
Chunk
Autorun -> String -> Doc
PP.text String
"#autorun"
Undef ByteString
t -> [Doc] -> Doc
PP.hsep [String -> Doc
PP.text String
"#undef", ByteString -> Doc
ppText ByteString
t]
where ppText :: ByteString -> Doc
ppText = String -> Doc
PP.text (String -> Doc) -> (ByteString -> String) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack
doubleQuotedString :: String -> String
doubleQuotedString :: String -> String
doubleQuotedString String
t = let
f :: Char -> String
f Char
'"' = String
"\\q"
f Char
'\n' = String
"\\n"
f Char
'\\' = String
"\\\\"
f Char
ch = [Char
ch]
in String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
ppTree :: Tree -> PP.Doc
ppTree :: Tree -> Doc
ppTree (Tree Word32
_ [Chunk]
chks)
| (Chunk -> Bool) -> [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Chunk -> Bool
simpleChunk [Chunk]
chks = [Doc] -> Doc
PP.hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Chunk -> Doc) -> [Chunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Doc
ppChunk [Chunk]
chks
| Bool
otherwise = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Chunk -> Doc) -> [Chunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Doc
ppChunk [Chunk]
chks
where simpleChunk :: Chunk -> Bool
simpleChunk Chunk
c = case Chunk
c of
Int Int32
_ -> Bool
True
Float Float
_ -> Bool
True
Var ByteString
_ -> Bool
True
Sym ByteString
_ -> Bool
True
Chunk
Unhandled -> Bool
True
Chunk
_ -> Bool
False
ppSym :: String -> String
ppSym :: String -> String
ppSym String
s
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
"_/.-=#<>&!") String
s Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) = String
s
| Bool
otherwise = let
f :: Char -> String
f Char
'\'' = String
"\\q"
f Char
'\n' = String
"\\n"
f Char
'\\' = String
"\\\\"
f Char
ch = [Char
ch]
in String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
ppDTA :: DTA -> PP.Doc
ppDTA :: DTA -> Doc
ppDTA = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> (DTA -> [Doc]) -> DTA -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> Doc) -> [Chunk] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Doc
ppChunk ([Chunk] -> [Doc]) -> (DTA -> [Chunk]) -> DTA -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree -> [Chunk]
treeChunks (Tree -> [Chunk]) -> (DTA -> Tree) -> DTA -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTA -> Tree
topTree
sToDTA :: DTA -> String
sToDTA :: DTA -> String
sToDTA = Doc -> String
PP.render (Doc -> String) -> (DTA -> Doc) -> DTA -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTA -> Doc
ppDTA