module Data.Text.Prettyprint.Doc.Render.GraphViz (
render,
render',
) where
import qualified Data.Text.Lazy as TL
import qualified Data.Text as T
import Data.GraphViz.Attributes.Complete (Label(HtmlLabel))
import qualified Data.GraphViz.Attributes.HTML as H
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (
Doc,
SimpleDocStream(
SFail,
SEmpty,
SChar,
SText,
SLine,
SAnnPush,
SAnnPop),
layoutPretty, defaultLayoutOptions,
)
import Data.Text.Prettyprint.Doc.Internal (textSpaces)
import Data.Text.Prettyprint.Doc.Render.Util.Panic (
panicUnpairedPop, panicInputNotFullyConsumed, panicUncaughtFail
)
render :: Doc H.Attribute -> Label
render :: Doc Attribute -> Label
render = Label -> Label
HtmlLabel (Label -> Label)
-> (Doc Attribute -> Label) -> Doc Attribute -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Label
H.Text (Text -> Label)
-> (Doc Attribute -> Text) -> Doc Attribute -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Attribute -> Text
render' (SimpleDocStream Attribute -> Text)
-> (Doc Attribute -> SimpleDocStream Attribute)
-> Doc Attribute
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Attribute -> SimpleDocStream Attribute
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions
render' :: SimpleDocStream H.Attribute -> H.Text
render' :: SimpleDocStream Attribute -> Text
render' = ([Attribute] -> Text -> Text)
-> (Attribute -> Text)
-> (Attribute -> Text)
-> SimpleDocStream Attribute
-> Text
forall out ann.
Monoid out =>
([ann] -> Text -> out)
-> (ann -> out) -> (ann -> out) -> SimpleDocStream ann -> out
renderSimplyDecorated' (TextItem -> Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextItem -> Text)
-> ([Attribute] -> Text -> TextItem) -> [Attribute] -> Text -> Text
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: [Attribute] -> Text -> TextItem
renderText) Attribute -> Text
forall a. Monoid a => a
mempty Attribute -> Text
forall a. Monoid a => a
mempty
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
.: :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = ((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d)
-> ((c -> d) -> (b -> c) -> b -> d)
-> (c -> d)
-> (a -> b -> c)
-> a
-> b
-> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
renderSimplyDecorated'
:: Monoid out
=> ([ann] -> Text -> out)
-> (ann -> out)
-> (ann -> out)
-> SimpleDocStream ann
-> out
renderSimplyDecorated' :: ([ann] -> Text -> out)
-> (ann -> out) -> (ann -> out) -> SimpleDocStream ann -> out
renderSimplyDecorated' [ann] -> Text -> out
text ann -> out
push ann -> out
pop = [ann] -> SimpleDocStream ann -> out
go []
where
go :: [ann] -> SimpleDocStream ann -> out
go [ann]
_ SimpleDocStream ann
SFail = out
forall void. void
panicUncaughtFail
go [] SimpleDocStream ann
SEmpty = out
forall a. Monoid a => a
mempty
go (ann
_:[ann]
_) SimpleDocStream ann
SEmpty = out
forall void. void
panicInputNotFullyConsumed
go [ann]
stack (SChar Char
c SimpleDocStream ann
rest) = [ann] -> Text -> out
text [ann]
stack (Char -> Text
T.singleton Char
c) out -> out -> out
forall a. Semigroup a => a -> a -> a
<> [ann] -> SimpleDocStream ann -> out
go [ann]
stack SimpleDocStream ann
rest
go [ann]
stack (SText Int
_l Text
t SimpleDocStream ann
rest) = [ann] -> Text -> out
text [ann]
stack Text
t out -> out -> out
forall a. Semigroup a => a -> a -> a
<> [ann] -> SimpleDocStream ann -> out
go [ann]
stack SimpleDocStream ann
rest
go [ann]
stack (SLine Int
i SimpleDocStream ann
rest) = [ann] -> Text -> out
text [ann]
stack (Char -> Text
T.singleton Char
'\n') out -> out -> out
forall a. Semigroup a => a -> a -> a
<> [ann] -> Text -> out
text [ann]
stack (Int -> Text
textSpaces Int
i) out -> out -> out
forall a. Semigroup a => a -> a -> a
<> [ann] -> SimpleDocStream ann -> out
go [ann]
stack SimpleDocStream ann
rest
go [ann]
stack (SAnnPush ann
ann SimpleDocStream ann
rest) = ann -> out
push ann
ann out -> out -> out
forall a. Semigroup a => a -> a -> a
<> [ann] -> SimpleDocStream ann -> out
go (ann
ann ann -> [ann] -> [ann]
forall a. a -> [a] -> [a]
: [ann]
stack) SimpleDocStream ann
rest
go (ann
ann:[ann]
stack) (SAnnPop SimpleDocStream ann
rest) = ann -> out
pop ann
ann out -> out -> out
forall a. Semigroup a => a -> a -> a
<> [ann] -> SimpleDocStream ann -> out
go [ann]
stack SimpleDocStream ann
rest
go [] SAnnPop{} = out
forall void. void
panicUnpairedPop
renderText :: H.Attributes -> T.Text -> H.TextItem
renderText :: [Attribute] -> Text -> TextItem
renderText [Attribute]
cs Text
t
| Text -> Bool
T.null Text
t = TextItem
ti
| Bool
otherwise = [Attribute] -> Text -> TextItem
H.Font [Attribute]
cs [TextItem
ti]
where ti :: TextItem
ti = Text -> TextItem
H.Str (Text -> TextItem) -> Text -> TextItem
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
t