{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleContexts #-}

module Network.TypedProtocol.Documentation.Text
where

import Control.Monad
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as LText
import Data.Word
import qualified Documentation.Haddock.Parser as Haddock
import qualified Documentation.Haddock.Types as Haddock
import Text.Printf
import Control.Monad.RWS
import Data.List (intersperse)

import Network.TypedProtocol.Documentation.Types

import Data.SerDoc.Class
import Data.SerDoc.Info

type Build = RWS Int LText.Builder Bool ()

runBuild :: Build -> LText.Text
runBuild :: Build -> Text
runBuild Build
a = Builder -> Text
LText.toLazyText Builder
b
  where
    ((), Bool
_, Builder
b) = Build -> Int -> Bool -> ((), Bool, Builder)
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS Build
a Int
0 Bool
False

indent :: Build
indent :: Build
indent = do
  atStart <- RWST Int Builder Bool Identity Bool
forall s (m :: * -> *). MonadState s m => m s
get
  when atStart $ do
    put False
    lvl <- ask
    replicateM_ lvl (tell " ")

assertLineStart :: Build
assertLineStart :: Build
assertLineStart = do
  atStart <- RWST Int Builder Bool Identity Bool
forall s (m :: * -> *). MonadState s m => m s
get
  unless atStart newline

withIndent :: Int -> Build -> Build
withIndent :: Int -> Build -> Build
withIndent Int
i = (Int -> Int) -> Build -> Build
forall a.
(Int -> Int)
-> RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)

write :: LText.Builder -> Build
write :: Builder -> Build
write Builder
b = Build
indent Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder -> Build
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
b

string :: String -> Build
string :: [Char] -> Build
string = Builder -> Build
write (Builder -> Build) -> ([Char] -> Builder) -> [Char] -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Builder
LText.fromString

newline :: Build
newline :: Build
newline = do
  [Char] -> Build
string [Char]
"\n"
  Bool -> Build
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True

buildBare :: Build -> LText.Text
buildBare :: Build -> Text
buildBare =
  [Text] -> Text
LText.unwords ([Text] -> Text) -> (Build -> [Text]) -> Build -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LText.words (Text -> [Text]) -> (Build -> Text) -> Build -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Build -> Text
runBuild

p :: Build -> Build
p :: Build -> Build
p Build
b = Build
b Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Build
newline

stringLine :: String -> Build
stringLine :: [Char] -> Build
stringLine = Build -> Build
p (Build -> Build) -> ([Char] -> Build) -> [Char] -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Build
string

h :: Int -> String -> Build
h :: Int -> [Char] -> Build
h Int
1 [Char]
s = do
  Build
assertLineStart
  [Char] -> Build
string [Char]
s
  Build
newline
  [Char] -> Build
stringLine ([Char] -> Build) -> [Char] -> Build
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'='
h Int
2 [Char]
s = do
  Build
assertLineStart
  [Char] -> Build
string [Char]
s
  Build
newline
  [Char] -> Build
stringLine ([Char] -> Build) -> [Char] -> Build
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'-'
  Build
newline
h Int
n [Char]
s = do
  Build
assertLineStart
  Int -> Build -> Build
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ [Char] -> Build
string [Char]
"#"
  [Char] -> Build
string [Char]
" "
  [Char] -> Build
string [Char]
s
  Build
newline

ul :: [Build] -> Build
ul :: [Build] -> Build
ul [Build]
items = do
  [Build] -> (Build -> Build) -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Build]
items ((Build -> Build) -> Build) -> (Build -> Build) -> Build
forall a b. (a -> b) -> a -> b
$ \Build
item -> do
    Build
assertLineStart
    [Char] -> Build
string [Char]
"- "
    Int -> Build -> Build
withIndent Int
2 Build
item
  Build
assertLineStart

ol :: [(Int, Build)] -> Build
ol :: [(Int, Build)] -> Build
ol [(Int, Build)]
items = do
  ((Int, Build) -> Build) -> [(Int, Build)] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> Build -> Build) -> (Int, Build) -> Build
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Build -> Build
renderItem) [(Int, Build)]
items
  Build
assertLineStart
  where
    renderItem :: Int -> Build -> Build
    renderItem :: Int -> Build -> Build
renderItem Int
n Build
item = do
      Build
assertLineStart
      [Char] -> Build
string ([Char] -> Build) -> (Int -> [Char]) -> Int -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Build) -> Int -> Build
forall a b. (a -> b) -> a -> b
$ Int
n
      [Char] -> Build
string [Char]
". "
      Int -> Build -> Build
withIndent Int
2 Build
item

link :: String -> Build -> Build
link :: [Char] -> Build -> Build
link [Char]
url Build
label = do
  [Char] -> Build
string [Char]
"["
  Build
label
  [Char] -> Build
string [Char]
"]("
  [Char] -> Build
string [Char]
url
  [Char] -> Build
string [Char]
")"

renderDescriptions :: [Description] -> Build
renderDescriptions :: [Description] -> Build
renderDescriptions = (Description -> Build) -> [Description] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Description -> Build) -> [Description] -> Build)
-> (Description -> Build) -> [Description] -> Build
forall a b. (a -> b) -> a -> b
$ \(Description [[Char]]
desc) -> do
    let ([DocH () [Char]]
docs :: [Haddock.DocH () String]) =
          ([Char] -> DocH () [Char]) -> [[Char]] -> [DocH () [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DocH () Identifier -> DocH () [Char]
forall mod. DocH mod Identifier -> DocH mod [Char]
Haddock.toRegular (DocH () Identifier -> DocH () [Char])
-> ([Char] -> DocH () Identifier) -> [Char] -> DocH () [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaDoc () Identifier -> DocH () Identifier
forall mod id. MetaDoc mod id -> DocH mod id
Haddock._doc (MetaDoc () Identifier -> DocH () Identifier)
-> ([Char] -> MetaDoc () Identifier)
-> [Char]
-> DocH () Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> [Char] -> MetaDoc () Identifier
forall mod. Maybe [Char] -> [Char] -> MetaDoc mod Identifier
Haddock.parseParas Maybe [Char]
forall a. Maybe a
Nothing) [[Char]]
desc
    (DocH () [Char] -> Build) -> [DocH () [Char]] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Build -> Build
p (Build -> Build)
-> (DocH () [Char] -> Build) -> DocH () [Char] -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocH () [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock) [DocH () [Char]]
docs

renderHaddock :: Haddock.DocH mod String -> Build
renderHaddock :: forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
Haddock.DocEmpty = () -> Build
forall a. a -> RWST Int Builder Bool Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderHaddock (Haddock.DocAppend DocH mod [Char]
a DocH mod [Char]
b) = DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
b
renderHaddock (Haddock.DocString [Char]
str) = [Char] -> Build
string [Char]
str
renderHaddock (Haddock.DocParagraph DocH mod [Char]
a) = Build -> Build
p (DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a)
renderHaddock (Haddock.DocIdentifier [Char]
i) = [Char] -> Build
string [Char]
i
renderHaddock (Haddock.DocIdentifierUnchecked mod
_) = [Char] -> Build
string [Char]
"**unchecked**"
renderHaddock (Haddock.DocModule (Haddock.ModLink [Char]
label Maybe (DocH mod [Char])
_)) = [Char] -> Build
string [Char]
label
renderHaddock (Haddock.DocWarning DocH mod [Char]
a) = Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a
renderHaddock (Haddock.DocEmphasis DocH mod [Char]
a) = DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a
renderHaddock (Haddock.DocMonospaced DocH mod [Char]
a) = DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a
renderHaddock (Haddock.DocBold DocH mod [Char]
a) = DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a
renderHaddock (Haddock.DocUnorderedList [DocH mod [Char]]
items) = [Build] -> Build
ul ([Build] -> Build) -> [Build] -> Build
forall a b. (a -> b) -> a -> b
$ (DocH mod [Char] -> Build) -> [DocH mod [Char]] -> [Build]
forall a b. (a -> b) -> [a] -> [b]
map DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock [DocH mod [Char]]
items
renderHaddock (Haddock.DocOrderedList [(Int, DocH mod [Char])]
items) = [(Int, Build)] -> Build
ol ([(Int, Build)] -> Build) -> [(Int, Build)] -> Build
forall a b. (a -> b) -> a -> b
$ ((Int, DocH mod [Char]) -> (Int, Build))
-> [(Int, DocH mod [Char])] -> [(Int, Build)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n, DocH mod [Char]
item) -> (Int
n, DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
item)) [(Int, DocH mod [Char])]
items
renderHaddock (Haddock.DocDefList [(DocH mod [Char], DocH mod [Char])]
items) =
  [Build] -> Build
ul
    [ DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
title Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string [Char]
": " Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
body
    | (DocH mod [Char]
title, DocH mod [Char]
body) <- [(DocH mod [Char], DocH mod [Char])]
items
    ]
renderHaddock (Haddock.DocCodeBlock DocH mod [Char]
a) = DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a
renderHaddock (Haddock.DocHyperlink (Haddock.Hyperlink [Char]
url Maybe (DocH mod [Char])
a)) =
  [Char] -> Build -> Build
link [Char]
url (Build
-> (DocH mod [Char] -> Build) -> Maybe (DocH mod [Char]) -> Build
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Build
string [Char]
"") DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock Maybe (DocH mod [Char])
a)
renderHaddock (Haddock.DocPic (Haddock.Picture [Char]
url Maybe [Char]
title)) = do
  [Char] -> Build
string [Char]
"<image:"
  Build -> ([Char] -> Build) -> Maybe [Char] -> Build
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Build
string [Char]
url) [Char] -> Build
string Maybe [Char]
title
  [Char] -> Build
string [Char]
">"
renderHaddock (Haddock.DocMathInline [Char]
str) = [Char] -> Build
string [Char]
str
renderHaddock (Haddock.DocMathDisplay [Char]
str) = Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ [Char] -> Build
string [Char]
str
renderHaddock (Haddock.DocAName [Char]
str) = [Char] -> Build
string [Char]
str
renderHaddock (Haddock.DocProperty [Char]
str) = [Char] -> Build
string [Char]
str
renderHaddock (Haddock.DocExamples [Example]
examples) =
  [Example] -> (Example -> Build) -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Example]
examples ((Example -> Build) -> Build) -> (Example -> Build) -> Build
forall a b. (a -> b) -> a -> b
$ \(Haddock.Example [Char]
expr [[Char]]
results) -> do
    Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      [Char] -> Build
string [Char]
"$> "
      [Char] -> Build
stringLine [Char]
expr
      ([Char] -> Build) -> [[Char]] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> Build
stringLine [[Char]]
results
renderHaddock (Haddock.DocHeader (Haddock.Header Int
level DocH mod [Char]
a)) = do
  let renderH :: [Char] -> Build
renderH = case Int
level of
                  Int
1 -> Int -> [Char] -> Build
h Int
1
                  Int
2 -> Int -> [Char] -> Build
h Int
2
                  Int
n -> Int -> [Char] -> Build
h Int
n
  [Char] -> Build
renderH ([Char] -> Build) -> (Build -> [Char]) -> Build -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
LText.unpack (Text -> [Char]) -> (Build -> Text) -> Build -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Build -> Text
buildBare (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
a
renderHaddock (Haddock.DocTable (Haddock.Table [TableRow (DocH mod [Char])]
headerRows [TableRow (DocH mod [Char])]
bodyRows)) = do
  (TableRow (DocH mod [Char]) -> Build)
-> [TableRow (DocH mod [Char])] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TableRow (DocH mod [Char]) -> Build
forall {mod}. TableRow (DocH mod [Char]) -> Build
row [TableRow (DocH mod [Char])]
headerRows
  [Char] -> Build
stringLine [Char]
"-----"
  (TableRow (DocH mod [Char]) -> Build)
-> [TableRow (DocH mod [Char])] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TableRow (DocH mod [Char]) -> Build
forall {mod}. TableRow (DocH mod [Char]) -> Build
row [TableRow (DocH mod [Char])]
bodyRows
  where
    row :: TableRow (DocH mod [Char]) -> Build
row (Haddock.TableRow [TableCell (DocH mod [Char])]
cells) = do
      Build
assertLineStart
      [Build] -> Build
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Build] -> Build)
-> ([TableCell (DocH mod [Char])] -> [Build])
-> [TableCell (DocH mod [Char])]
-> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Build -> [Build] -> [Build]
forall a. a -> [a] -> [a]
intersperse ([Char] -> Build
string [Char]
" | ") ([Build] -> [Build])
-> ([TableCell (DocH mod [Char])] -> [Build])
-> [TableCell (DocH mod [Char])]
-> [Build]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableCell (DocH mod [Char]) -> Build)
-> [TableCell (DocH mod [Char])] -> [Build]
forall a b. (a -> b) -> [a] -> [b]
map TableCell (DocH mod [Char]) -> Build
forall {mod}. TableCell (DocH mod [Char]) -> Build
renderCell ([TableCell (DocH mod [Char])] -> Build)
-> [TableCell (DocH mod [Char])] -> Build
forall a b. (a -> b) -> a -> b
$ [TableCell (DocH mod [Char])]
cells
      Build
assertLineStart
    renderCell :: TableCell (DocH mod [Char]) -> Build
renderCell (Haddock.TableCell Int
_ Int
_ DocH mod [Char]
content) =
      DocH mod [Char] -> Build
forall mod. DocH mod [Char] -> Build
renderHaddock DocH mod [Char]
content

data TOC a = TOC a [TOC a]
  deriving (Int -> TOC a -> ShowS
[TOC a] -> ShowS
TOC a -> [Char]
(Int -> TOC a -> ShowS)
-> (TOC a -> [Char]) -> ([TOC a] -> ShowS) -> Show (TOC a)
forall a. Show a => Int -> TOC a -> ShowS
forall a. Show a => [TOC a] -> ShowS
forall a. Show a => TOC a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> TOC a -> ShowS
showsPrec :: Int -> TOC a -> ShowS
$cshow :: forall a. Show a => TOC a -> [Char]
show :: TOC a -> [Char]
$cshowList :: forall a. Show a => [TOC a] -> ShowS
showList :: [TOC a] -> ShowS
Show, TOC a -> TOC a -> Bool
(TOC a -> TOC a -> Bool) -> (TOC a -> TOC a -> Bool) -> Eq (TOC a)
forall a. Eq a => TOC a -> TOC a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => TOC a -> TOC a -> Bool
== :: TOC a -> TOC a -> Bool
$c/= :: forall a. Eq a => TOC a -> TOC a -> Bool
/= :: TOC a -> TOC a -> Bool
Eq, Eq (TOC a)
Eq (TOC a) =>
(TOC a -> TOC a -> Ordering)
-> (TOC a -> TOC a -> Bool)
-> (TOC a -> TOC a -> Bool)
-> (TOC a -> TOC a -> Bool)
-> (TOC a -> TOC a -> Bool)
-> (TOC a -> TOC a -> TOC a)
-> (TOC a -> TOC a -> TOC a)
-> Ord (TOC a)
TOC a -> TOC a -> Bool
TOC a -> TOC a -> Ordering
TOC a -> TOC a -> TOC a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (TOC a)
forall a. Ord a => TOC a -> TOC a -> Bool
forall a. Ord a => TOC a -> TOC a -> Ordering
forall a. Ord a => TOC a -> TOC a -> TOC a
$ccompare :: forall a. Ord a => TOC a -> TOC a -> Ordering
compare :: TOC a -> TOC a -> Ordering
$c< :: forall a. Ord a => TOC a -> TOC a -> Bool
< :: TOC a -> TOC a -> Bool
$c<= :: forall a. Ord a => TOC a -> TOC a -> Bool
<= :: TOC a -> TOC a -> Bool
$c> :: forall a. Ord a => TOC a -> TOC a -> Bool
> :: TOC a -> TOC a -> Bool
$c>= :: forall a. Ord a => TOC a -> TOC a -> Bool
>= :: TOC a -> TOC a -> Bool
$cmax :: forall a. Ord a => TOC a -> TOC a -> TOC a
max :: TOC a -> TOC a -> TOC a
$cmin :: forall a. Ord a => TOC a -> TOC a -> TOC a
min :: TOC a -> TOC a -> TOC a
Ord)

renderTOC :: TOC (String, String) -> Build
renderTOC :: TOC ([Char], [Char]) -> Build
renderTOC (TOC ([Char]
label, [Char]
_href) [TOC ([Char], [Char])]
children) = do
  [Char] -> Build
stringLine [Char]
label
  Int -> Build -> Build
withIndent Int
2 (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ [TOC ([Char], [Char])] -> (TOC ([Char], [Char]) -> Build) -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TOC ([Char], [Char])]
children TOC ([Char], [Char]) -> Build
renderTOC

stateID :: String -> String -> String
stateID :: [Char] -> ShowS
stateID [Char]
protoName [Char]
stateName = [Char]
protoName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_state_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
stateName

stateTOC :: String -> String -> TOC (String, String)
stateTOC :: [Char] -> [Char] -> TOC ([Char], [Char])
stateTOC [Char]
protoName [Char]
stateName = ([Char], [Char]) -> [TOC ([Char], [Char])] -> TOC ([Char], [Char])
forall a. a -> [TOC a] -> TOC a
TOC ([Char]
stateName, [Char] -> ShowS
stateID [Char]
protoName [Char]
stateName) []

renderMessageRef :: String -> MessageDescription codec -> Build
renderMessageRef :: forall codec. [Char] -> MessageDescription codec -> Build
renderMessageRef [Char]
toFrom MessageDescription codec
msg = do
  [Char] -> Build
string (MessageDescription codec -> [Char]
forall codec. MessageDescription codec -> [Char]
messageName MessageDescription codec
msg)
  [Char] -> Build
string [Char]
" ("
  [Char] -> Build
string [Char]
toFrom
  [Char] -> Build
string [Char]
" "
  StateRef -> Build
formatStateRef (MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageToState MessageDescription codec
msg)
  [Char] -> Build
string [Char]
")"

renderState :: [MessageDescription codec] -> (StateRef, [Description], AgencyID) -> Build
renderState :: forall codec.
[MessageDescription codec]
-> (StateRef, [Description], AgencyID) -> Build
renderState [MessageDescription codec]
_ (StateRef
AnyState, [Description]
_, AgencyID
_) =
  () -> Build
forall a. a -> RWST Int Builder Bool Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderState [MessageDescription codec]
msgs (State [Char]
stateName, [Description]
descriptions, AgencyID
agency) =
  Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
    Int -> [Char] -> Build
h Int
3 [Char]
stateName
    Build
newline
    [Description] -> Build
renderDescriptions [Description]
descriptions
    Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      [Char] -> Build
string [Char]
"Agency: "
      case AgencyID
agency of
        AgencyID
ClientAgencyID -> [Char] -> Build
string [Char]
"client"
        AgencyID
ServerAgencyID -> [Char] -> Build
string [Char]
"server"
        AgencyID
NobodyAgencyID -> [Char] -> Build
string [Char]
"nobody"
    Bool -> Build -> Build
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([MessageDescription codec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MessageDescription codec]
messagesFromHere) (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      Int -> [Char] -> Build
h Int
4 [Char]
"Messages from here:"
      [Build] -> Build
ul ([Build] -> Build) -> [Build] -> Build
forall a b. (a -> b) -> a -> b
$ (MessageDescription codec -> Build)
-> [MessageDescription codec] -> [Build]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> MessageDescription codec -> Build
forall codec. [Char] -> MessageDescription codec -> Build
renderMessageRef [Char]
"to") [MessageDescription codec]
messagesFromHere
    Bool -> Build -> Build
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([MessageDescription codec] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MessageDescription codec]
messagesToHere) (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      Int -> [Char] -> Build
h Int
4 [Char]
"Messages to here:"
      [Build] -> Build
ul ([Build] -> Build) -> [Build] -> Build
forall a b. (a -> b) -> a -> b
$ (MessageDescription codec -> Build)
-> [MessageDescription codec] -> [Build]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> MessageDescription codec -> Build
forall codec. [Char] -> MessageDescription codec -> Build
renderMessageRef [Char]
"from") [MessageDescription codec]
messagesToHere
  where
    messagesFromHere :: [MessageDescription codec]
messagesFromHere = (MessageDescription codec -> Bool)
-> [MessageDescription codec] -> [MessageDescription codec]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> StateRef -> Bool
matchState [Char]
stateName (StateRef -> Bool)
-> (MessageDescription codec -> StateRef)
-> MessageDescription codec
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageFromState) [MessageDescription codec]
msgs
    messagesToHere :: [MessageDescription codec]
messagesToHere = (MessageDescription codec -> Bool)
-> [MessageDescription codec] -> [MessageDescription codec]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> StateRef -> Bool
matchState [Char]
stateName (StateRef -> Bool)
-> (MessageDescription codec -> StateRef)
-> MessageDescription codec
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageToState) [MessageDescription codec]
msgs

    matchState :: String -> StateRef -> Bool
    matchState :: [Char] -> StateRef -> Bool
matchState [Char]
_ StateRef
AnyState = Bool
True
    matchState [Char]
a (State [Char]
b) = [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
b

formatStateRef :: StateRef -> Build
formatStateRef :: StateRef -> Build
formatStateRef StateRef
AnyState =
  [Char] -> Build
string [Char]
"any state"
formatStateRef (State [Char]
name) =
  [Char] -> Build
string [Char]
name

messageID :: String -> String -> String
messageID :: [Char] -> ShowS
messageID [Char]
protoName [Char]
msgName = [Char]
protoName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_message_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msgName

messageTOC :: String -> MessageDescription codec -> TOC (String, String)
messageTOC :: forall codec.
[Char] -> MessageDescription codec -> TOC ([Char], [Char])
messageTOC [Char]
protoName MessageDescription codec
msg =
  ([Char], [Char]) -> [TOC ([Char], [Char])] -> TOC ([Char], [Char])
forall a. a -> [TOC a] -> TOC a
TOC (MessageDescription codec -> [Char]
forall codec. MessageDescription codec -> [Char]
messageName MessageDescription codec
msg, [Char] -> ShowS
messageID [Char]
protoName (MessageDescription codec -> [Char]
forall codec. MessageDescription codec -> [Char]
messageName MessageDescription codec
msg)) []

formatFieldSize :: FieldSize -> String
formatFieldSize :: FieldSize -> [Char]
formatFieldSize (FixedSize Int
n) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
formatFieldSize (VarSize [Char]
var) = [Char]
var
formatFieldSize FieldSize
UnknownSize = [Char]
"VARIABLE"
formatFieldSize FieldSize
EnumSize = [Char]
"ENUM"
formatFieldSize (RangeSize FieldSize
lo FieldSize
hi) = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
lo [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" .. " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
hi [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
formatFieldSize (BinopSize FieldSizeBinop
FSPlus FieldSize
a FieldSize
b) = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" + " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
formatFieldSize (BinopSize FieldSizeBinop
FSMul FieldSize
a FieldSize
b) = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" * " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
formatFieldSize (BinopSize FieldSizeBinop
FSMax FieldSize
a FieldSize
b) = [Char]
"MAX(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
formatFieldSize (BinopSize FieldSizeBinop
FSMin FieldSize
a FieldSize
b) = [Char]
"MIN(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldSize -> [Char]
formatFieldSize FieldSize
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

renderMessage :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
              => MessageDescription codec -> Build
renderMessage :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
MessageDescription codec -> Build
renderMessage MessageDescription codec
msg =
  Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
    Int -> [Char] -> Build
h Int
3 ([Char] -> Build) -> [Char] -> Build
forall a b. (a -> b) -> a -> b
$ MessageDescription codec -> [Char]
forall codec. MessageDescription codec -> [Char]
messageName MessageDescription codec
msg
    Build
newline
    [Description] -> Build
renderDescriptions (MessageDescription codec -> [Description]
forall codec. MessageDescription codec -> [Description]
messageDescription MessageDescription codec
msg)
    Int -> [Char] -> Build
h Int
4 [Char]
"State Transition"
    Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      StateRef -> Build
formatStateRef (MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageFromState MessageDescription codec
msg)
      [Char] -> Build
string [Char]
" -> "
      StateRef -> Build
formatStateRef (MessageDescription codec -> StateRef
forall codec. MessageDescription codec -> StateRef
messageToState MessageDescription codec
msg)
    Bool -> Build -> Build
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool) -> [[Char]] -> Bool
forall a b. (a -> b) -> a -> b
$ MessageDescription codec -> [[Char]]
forall codec. MessageDescription codec -> [[Char]]
messagePayload MessageDescription codec
msg) (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      Int -> [Char] -> Build
h Int
4 [Char]
"Payload"
      [Build] -> Build
ul ([Build] -> Build) -> [Build] -> Build
forall a b. (a -> b) -> a -> b
$ ([Char] -> Build) -> [[Char]] -> [Build]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Build
string (MessageDescription codec -> [[Char]]
forall codec. MessageDescription codec -> [[Char]]
messagePayload MessageDescription codec
msg)
    Int -> [Char] -> Build
h Int
4 [Char]
"Serialization Format"
    FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldSpec (MessageDescription codec -> FieldInfo codec
forall codec. MessageDescription codec -> FieldInfo codec
messageInfo MessageDescription codec
msg)
    Build
newline
  
protocolTOC :: ProtocolDescription codec -> TOC (String, String)
protocolTOC :: forall codec. ProtocolDescription codec -> TOC ([Char], [Char])
protocolTOC ProtocolDescription codec
proto =
  let protoName :: [Char]
protoName = ProtocolDescription codec -> [Char]
forall codec. ProtocolDescription codec -> [Char]
protocolName ProtocolDescription codec
proto
  in
    ([Char], [Char]) -> [TOC ([Char], [Char])] -> TOC ([Char], [Char])
forall a. a -> [TOC a] -> TOC a
TOC ([Char]
protoName, [Char]
protoName)
      [ ([Char], [Char]) -> [TOC ([Char], [Char])] -> TOC ([Char], [Char])
forall a. a -> [TOC a] -> TOC a
TOC ([Char]
"States", [Char]
protoName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_states")
        [ [Char] -> [Char] -> TOC ([Char], [Char])
stateTOC [Char]
protoName [Char]
stateName | (State [Char]
stateName, [Description]
_, AgencyID
_) <- ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
forall codec.
ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
protocolStates ProtocolDescription codec
proto ]
      , ([Char], [Char]) -> [TOC ([Char], [Char])] -> TOC ([Char], [Char])
forall a. a -> [TOC a] -> TOC a
TOC ([Char]
"Messages", [Char]
protoName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_messages")
        [ [Char] -> MessageDescription codec -> TOC ([Char], [Char])
forall codec.
[Char] -> MessageDescription codec -> TOC ([Char], [Char])
messageTOC [Char]
protoName MessageDescription codec
msg | MessageDescription codec
msg <- ProtocolDescription codec -> [MessageDescription codec]
forall codec.
ProtocolDescription codec -> [MessageDescription codec]
protocolMessages ProtocolDescription codec
proto ]
      ]

renderProtocol :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
               => ProtocolDescription codec -> Build
renderProtocol :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
ProtocolDescription codec -> Build
renderProtocol ProtocolDescription codec
proto = do
  let protoName :: [Char]
protoName = ProtocolDescription codec -> [Char]
forall codec. ProtocolDescription codec -> [Char]
protocolName ProtocolDescription codec
proto
      msgs :: [MessageDescription codec]
msgs = ProtocolDescription codec -> [MessageDescription codec]
forall codec.
ProtocolDescription codec -> [MessageDescription codec]
protocolMessages ProtocolDescription codec
proto
  Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
    Int -> [Char] -> Build
h Int
1 [Char]
protoName
    [Char] -> Build
string (ProtocolDescription codec -> [Char]
forall codec. ProtocolDescription codec -> [Char]
protocolIdentifier ProtocolDescription codec
proto)
    Build
assertLineStart
    [Description] -> Build
renderDescriptions (ProtocolDescription codec -> [Description]
forall codec. ProtocolDescription codec -> [Description]
protocolDescription ProtocolDescription codec
proto)
    Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      Int -> [Char] -> Build
h Int
2 [Char]
"States"
      [()] -> ()
forall a. Monoid a => [a] -> a
mconcat ([()] -> ()) -> RWST Int Builder Bool Identity [()] -> Build
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((StateRef, [Description], AgencyID) -> Build)
-> [(StateRef, [Description], AgencyID)]
-> RWST Int Builder Bool Identity [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([MessageDescription codec]
-> (StateRef, [Description], AgencyID) -> Build
forall codec.
[MessageDescription codec]
-> (StateRef, [Description], AgencyID) -> Build
renderState [MessageDescription codec]
msgs) (ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
forall codec.
ProtocolDescription codec -> [(StateRef, [Description], AgencyID)]
protocolStates ProtocolDescription codec
proto)
    Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ do
      Int -> [Char] -> Build
h Int
2 [Char]
"Messages"
      [()] -> ()
forall a. Monoid a => [a] -> a
mconcat ([()] -> ()) -> RWST Int Builder Bool Identity [()] -> Build
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MessageDescription codec -> Build)
-> [MessageDescription codec]
-> RWST Int Builder Bool Identity [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM MessageDescription codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
MessageDescription codec -> Build
renderMessage [MessageDescription codec]
msgs

renderFieldSpec :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
                => FieldInfo codec -> Build
renderFieldSpec :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldSpec FieldInfo codec
fi = do
  [[Char]] -> ([Char] -> Build) -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (FieldInfo codec -> [[Char]]
forall codec. FieldInfo codec -> [[Char]]
fieldSpecAnnotations FieldInfo codec
fi) (Build -> Build
p (Build -> Build) -> ([Char] -> Build) -> [Char] -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Build
string)
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields ([Char] -> [([Char], FieldInfo codec)] -> FieldInfo codec
forall codec.
[Char] -> [([Char], FieldInfo codec)] -> FieldInfo codec
compoundField [Char]
"" [([Char]
"", FieldInfo codec
fi)])

fieldSpecAnnotations :: FieldInfo codec -> [String]
fieldSpecAnnotations :: forall codec. FieldInfo codec -> [[Char]]
fieldSpecAnnotations (AnnField [Char]
ann FieldInfo codec
fi) =
  [Char]
ann [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: FieldInfo codec -> [[Char]]
forall codec. FieldInfo codec -> [[Char]]
fieldSpecAnnotations FieldInfo codec
fi
fieldSpecAnnotations FieldInfo codec
_ = []

renderSubfields :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
                => FieldInfo codec -> Build
renderSubfields :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields (AnnField [Char]
_ FieldInfo codec
fi) =
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields FieldInfo codec
fi
renderSubfields (AliasField AliasFieldInfo codec
afi) =
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields (AliasFieldInfo codec -> FieldInfo codec
forall codec. AliasFieldInfo codec -> FieldInfo codec
aliasFieldTarget AliasFieldInfo codec
afi)
renderSubfields (CompoundField CompoundFieldInfo codec
cfi) = do
  [Build] -> Build
ul ([Build] -> Build) -> [Build] -> Build
forall a b. (a -> b) -> a -> b
$ (SubfieldInfo codec -> Build) -> [SubfieldInfo codec] -> [Build]
forall a b. (a -> b) -> [a] -> [b]
map SubfieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
SubfieldInfo codec -> Build
renderSubfield (CompoundFieldInfo codec -> [SubfieldInfo codec]
forall codec. CompoundFieldInfo codec -> [SubfieldInfo codec]
compoundFieldSubfields CompoundFieldInfo codec
cfi)
renderSubfields FieldInfo codec
_ = () -> Build
forall a. a -> RWST Int Builder Bool Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

renderFieldType :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
                => FieldInfo codec -> Build
renderFieldType :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType (AnnField [Char]
_ FieldInfo codec
fi) =
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType FieldInfo codec
fi
renderFieldType (AliasField AliasFieldInfo codec
fi) = do
  [Char] -> Build
string (AliasFieldInfo codec -> [Char]
forall codec. AliasFieldInfo codec -> [Char]
aliasFieldName AliasFieldInfo codec
fi)
  Build
assertLineStart

  [Char] -> Build
string [Char]
"This type is an alias for: "
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType (AliasFieldInfo codec -> FieldInfo codec
forall codec. AliasFieldInfo codec -> FieldInfo codec
aliasFieldTarget AliasFieldInfo codec
fi)
renderFieldType (ListField ListFieldInfo codec
fi) = do
  [Char] -> Build
string [Char]
"["
  [Char] -> Build
string (FieldInfo codec -> [Char]
forall codec. FieldInfo codec -> [Char]
shortFieldType (ListFieldInfo codec -> FieldInfo codec
forall codec. ListFieldInfo codec -> FieldInfo codec
listElemInfo ListFieldInfo codec
fi))
  [Char] -> Build
string [Char]
"] "
  Build
assertLineStart

  [Char] -> Build
string [Char]
"items: "
  [Char] -> Build
string ([Char] -> Build) -> [Char] -> Build
forall a b. (a -> b) -> a -> b
$ FieldSize -> [Char]
formatFieldSize (FieldSize -> [Char]) -> FieldSize -> [Char]
forall a b. (a -> b) -> a -> b
$ ListFieldInfo codec -> FieldSize
forall codec. ListFieldInfo codec -> FieldSize
listSize ListFieldInfo codec
fi
  Build
assertLineStart

  [Char] -> Build
string [Char]
"item type: "
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType (ListFieldInfo codec -> FieldInfo codec
forall codec. ListFieldInfo codec -> FieldInfo codec
listElemInfo ListFieldInfo codec
fi)
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields (ListFieldInfo codec -> FieldInfo codec
forall codec. ListFieldInfo codec -> FieldInfo codec
listElemInfo ListFieldInfo codec
fi)
renderFieldType (ChoiceField ChoiceFieldInfo codec
fi) = do
  [Char] -> Build
string [Char]
"Choice ("
  case ChoiceFieldInfo codec -> ChoiceCondition
forall codec. ChoiceFieldInfo codec -> ChoiceCondition
choiceCondition ChoiceFieldInfo codec
fi of
    IndexField [Char]
ref -> [Char] -> Build
string [Char]
ref
    IndexFlag [Char]
ref Word32
mask -> [Char] -> Build
string [Char]
ref Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string [Char]
" & " Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string ([Char] -> Word32 -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"0x%04x" Word32
mask)
  [Char] -> Build
string [Char]
")"
  Build
assertLineStart
  [Build] -> Build
ul [ [Char] -> Build
string (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       [Char] -> Build
string [Char]
": " Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields FieldInfo codec
optInfo Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Build
assertLineStart Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       [Char] -> Build
string [Char]
"size: " Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string (FieldSize -> [Char]
formatFieldSize (FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> FieldSize
fieldSize FieldInfo codec
optInfo)) Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Build
assertLineStart
     | (Int
n :: Int, FieldInfo codec
optInfo) <- [Int] -> [FieldInfo codec] -> [(Int, FieldInfo codec)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0,Int
1..] (ChoiceFieldInfo codec -> [FieldInfo codec]
forall codec. ChoiceFieldInfo codec -> [FieldInfo codec]
choiceFieldAlternatives ChoiceFieldInfo codec
fi)
     ]
renderFieldType (EnumField EnumFieldInfo
fi) = do
  [Char] -> Build
string (EnumFieldInfo -> [Char]
enumFieldType EnumFieldInfo
fi)
  [Char] -> Build
string [Char]
" (enum)"
  Build
assertLineStart
  [Build] -> Build
ul [ [Char] -> Build
string (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
val) Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string [Char]
" = " Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string [Char]
name
     | (Int
val, [Char]
name) <- EnumFieldInfo -> [(Int, [Char])]
enumFieldValues EnumFieldInfo
fi
     ]
renderFieldType (SumField SumFieldInfo codec
fi) = do
  [Char] -> Build
string (SumFieldInfo codec -> [Char]
forall codec. SumFieldInfo codec -> [Char]
sumFieldType SumFieldInfo codec
fi)
  [Char] -> Build
string [Char]
" (union)"
  Build
assertLineStart
  case SumFieldInfo codec -> [([Char], FieldInfo codec)]
forall codec. SumFieldInfo codec -> [([Char], FieldInfo codec)]
sumFieldAlternatives SumFieldInfo codec
fi of
    [([Char]
_name, FieldInfo codec
sfi)] ->
      Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType FieldInfo codec
sfi
    [([Char], FieldInfo codec)]
sfis ->
      [Build] -> Build
ul [ [Char] -> Build
string [Char]
name Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Build
string [Char]
": " Build -> Build -> Build
forall a b.
RWST Int Builder Bool Identity a
-> RWST Int Builder Bool Identity b
-> RWST Int Builder Bool Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType FieldInfo codec
sfi
         | ([Char]
name, FieldInfo codec
sfi) <- [([Char], FieldInfo codec)]
sfis
         ]
renderFieldType FieldInfo codec
fi =
  [Char] -> Build
string ([Char] -> Build)
-> (FieldInfo codec -> [Char]) -> FieldInfo codec -> Build
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo codec -> [Char]
forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType (FieldInfo codec -> Build) -> FieldInfo codec -> Build
forall a b. (a -> b) -> a -> b
$ FieldInfo codec
fi

renderSubfield :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
                 => SubfieldInfo codec -> Build
renderSubfield :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
SubfieldInfo codec -> Build
renderSubfield SubfieldInfo codec
sfi = do
  [Char] -> Build
string (SubfieldInfo codec -> [Char]
forall codec. SubfieldInfo codec -> [Char]
subfieldName SubfieldInfo codec
sfi)
  Build
assertLineStart
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderFieldType (SubfieldInfo codec -> FieldInfo codec
forall codec. SubfieldInfo codec -> FieldInfo codec
subfieldInfo SubfieldInfo codec
sfi)
  Build
assertLineStart
  [Char] -> Build
string [Char]
"size: "
  [Char] -> Build
string (FieldSize -> [Char]
formatFieldSize (FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> FieldSize
fieldSize (SubfieldInfo codec -> FieldInfo codec
forall codec. SubfieldInfo codec -> FieldInfo codec
subfieldInfo SubfieldInfo codec
sfi)))
  [Char] -> Build
string [Char]
" "
  FieldInfo codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> Build
renderSubfields (SubfieldInfo codec -> FieldInfo codec
forall codec. SubfieldInfo codec -> FieldInfo codec
subfieldInfo SubfieldInfo codec
sfi)

renderProtocolDescriptions :: (HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec))
                           => [ProtocolDescription codec] -> LText.Text
renderProtocolDescriptions :: forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
[ProtocolDescription codec] -> Text
renderProtocolDescriptions [ProtocolDescription codec]
protos = Build -> Text
runBuild (Build -> Text) -> Build -> Text
forall a b. (a -> b) -> a -> b
$ do
    Int -> [Char] -> Build
h Int
1 [Char]
"Table Of Contents"
    Build -> Build
p (Build -> Build) -> Build -> Build
forall a b. (a -> b) -> a -> b
$ TOC ([Char], [Char]) -> Build
renderTOC (([Char], [Char]) -> [TOC ([Char], [Char])] -> TOC ([Char], [Char])
forall a. a -> [TOC a] -> TOC a
TOC ([Char]
"Protocols",[Char]
"") ((ProtocolDescription codec -> TOC ([Char], [Char]))
-> [ProtocolDescription codec] -> [TOC ([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ProtocolDescription codec -> TOC ([Char], [Char])
forall codec. ProtocolDescription codec -> TOC ([Char], [Char])
protocolTOC [ProtocolDescription codec]
protos))
    (ProtocolDescription codec -> Build)
-> [ProtocolDescription codec] -> Build
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ProtocolDescription codec -> Build
forall codec.
(HasInfo codec Word32, HasInfo codec (DefEnumEncoding codec)) =>
ProtocolDescription codec -> Build
renderProtocol [ProtocolDescription codec]
protos