{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Codec.CBOR.Cuddle.Pretty (
  CommentRender (..),
  PrettyStage,
  XXTopLevel (..),
  XXType2 (..),
  XTerm (..),
  XCddl (..),
  XRule (..),
) where

import Codec.CBOR.Cuddle.CDDL
import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment (..), HasComment (..), unComment)
import Codec.CBOR.Cuddle.Pretty.Columnar (
  Cell (..),
  CellAlign (..),
  Columnar (..),
  Row (..),
  cellL,
  columnarListing,
  columnarSepBy,
  emptyCell,
  prettyColumnar,
  singletonRow,
 )
import Codec.CBOR.Cuddle.Pretty.Utils (renderedLen, softspace)
import Data.ByteString.Base16 qualified as B16
import Data.ByteString.Char8 qualified as BS
import Data.Default.Class (Default)
import Data.Foldable (Foldable (..))
import Data.List.NonEmpty qualified as NE
import Data.String (IsString, fromString)
import Data.Text qualified as T
import Data.TreeDiff (ToExpr)
import Data.Void (Void, absurd)
import GHC.Generics (Generic)
import Optics.Core ((^.))
import Prettyprinter

type data PrettyStage

newtype instance XXTopLevel PrettyStage = PrettyXXTopLevel Comment
  deriving ((forall x.
 XXTopLevel PrettyStage -> Rep (XXTopLevel PrettyStage) x)
-> (forall x.
    Rep (XXTopLevel PrettyStage) x -> XXTopLevel PrettyStage)
-> Generic (XXTopLevel PrettyStage)
forall x. Rep (XXTopLevel PrettyStage) x -> XXTopLevel PrettyStage
forall x. XXTopLevel PrettyStage -> Rep (XXTopLevel PrettyStage) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XXTopLevel PrettyStage -> Rep (XXTopLevel PrettyStage) x
from :: forall x. XXTopLevel PrettyStage -> Rep (XXTopLevel PrettyStage) x
$cto :: forall x. Rep (XXTopLevel PrettyStage) x -> XXTopLevel PrettyStage
to :: forall x. Rep (XXTopLevel PrettyStage) x -> XXTopLevel PrettyStage
Generic, XXTopLevel PrettyStage -> [Comment]
(XXTopLevel PrettyStage -> [Comment])
-> CollectComments (XXTopLevel PrettyStage)
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: XXTopLevel PrettyStage -> [Comment]
collectComments :: XXTopLevel PrettyStage -> [Comment]
CollectComments, [XXTopLevel PrettyStage] -> Expr
XXTopLevel PrettyStage -> Expr
(XXTopLevel PrettyStage -> Expr)
-> ([XXTopLevel PrettyStage] -> Expr)
-> ToExpr (XXTopLevel PrettyStage)
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: XXTopLevel PrettyStage -> Expr
toExpr :: XXTopLevel PrettyStage -> Expr
$clistToExpr :: [XXTopLevel PrettyStage] -> Expr
listToExpr :: [XXTopLevel PrettyStage] -> Expr
ToExpr, Int -> XXTopLevel PrettyStage -> ShowS
[XXTopLevel PrettyStage] -> ShowS
XXTopLevel PrettyStage -> String
(Int -> XXTopLevel PrettyStage -> ShowS)
-> (XXTopLevel PrettyStage -> String)
-> ([XXTopLevel PrettyStage] -> ShowS)
-> Show (XXTopLevel PrettyStage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XXTopLevel PrettyStage -> ShowS
showsPrec :: Int -> XXTopLevel PrettyStage -> ShowS
$cshow :: XXTopLevel PrettyStage -> String
show :: XXTopLevel PrettyStage -> String
$cshowList :: [XXTopLevel PrettyStage] -> ShowS
showList :: [XXTopLevel PrettyStage] -> ShowS
Show, XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool
(XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool)
-> (XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool)
-> Eq (XXTopLevel PrettyStage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool
== :: XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool
$c/= :: XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool
/= :: XXTopLevel PrettyStage -> XXTopLevel PrettyStage -> Bool
Eq)

newtype instance XXType2 PrettyStage = PrettyXXType2 Void
  deriving ((forall x. XXType2 PrettyStage -> Rep (XXType2 PrettyStage) x)
-> (forall x. Rep (XXType2 PrettyStage) x -> XXType2 PrettyStage)
-> Generic (XXType2 PrettyStage)
forall x. Rep (XXType2 PrettyStage) x -> XXType2 PrettyStage
forall x. XXType2 PrettyStage -> Rep (XXType2 PrettyStage) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XXType2 PrettyStage -> Rep (XXType2 PrettyStage) x
from :: forall x. XXType2 PrettyStage -> Rep (XXType2 PrettyStage) x
$cto :: forall x. Rep (XXType2 PrettyStage) x -> XXType2 PrettyStage
to :: forall x. Rep (XXType2 PrettyStage) x -> XXType2 PrettyStage
Generic, XXType2 PrettyStage -> [Comment]
(XXType2 PrettyStage -> [Comment])
-> CollectComments (XXType2 PrettyStage)
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: XXType2 PrettyStage -> [Comment]
collectComments :: XXType2 PrettyStage -> [Comment]
CollectComments, [XXType2 PrettyStage] -> Expr
XXType2 PrettyStage -> Expr
(XXType2 PrettyStage -> Expr)
-> ([XXType2 PrettyStage] -> Expr) -> ToExpr (XXType2 PrettyStage)
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: XXType2 PrettyStage -> Expr
toExpr :: XXType2 PrettyStage -> Expr
$clistToExpr :: [XXType2 PrettyStage] -> Expr
listToExpr :: [XXType2 PrettyStage] -> Expr
ToExpr, Int -> XXType2 PrettyStage -> ShowS
[XXType2 PrettyStage] -> ShowS
XXType2 PrettyStage -> String
(Int -> XXType2 PrettyStage -> ShowS)
-> (XXType2 PrettyStage -> String)
-> ([XXType2 PrettyStage] -> ShowS)
-> Show (XXType2 PrettyStage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XXType2 PrettyStage -> ShowS
showsPrec :: Int -> XXType2 PrettyStage -> ShowS
$cshow :: XXType2 PrettyStage -> String
show :: XXType2 PrettyStage -> String
$cshowList :: [XXType2 PrettyStage] -> ShowS
showList :: [XXType2 PrettyStage] -> ShowS
Show, XXType2 PrettyStage -> XXType2 PrettyStage -> Bool
(XXType2 PrettyStage -> XXType2 PrettyStage -> Bool)
-> (XXType2 PrettyStage -> XXType2 PrettyStage -> Bool)
-> Eq (XXType2 PrettyStage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XXType2 PrettyStage -> XXType2 PrettyStage -> Bool
== :: XXType2 PrettyStage -> XXType2 PrettyStage -> Bool
$c/= :: XXType2 PrettyStage -> XXType2 PrettyStage -> Bool
/= :: XXType2 PrettyStage -> XXType2 PrettyStage -> Bool
Eq)

newtype instance XTerm PrettyStage = PrettyXTerm {XTerm PrettyStage -> Comment
unPrettyXTerm :: Comment}
  deriving ((forall x. XTerm PrettyStage -> Rep (XTerm PrettyStage) x)
-> (forall x. Rep (XTerm PrettyStage) x -> XTerm PrettyStage)
-> Generic (XTerm PrettyStage)
forall x. Rep (XTerm PrettyStage) x -> XTerm PrettyStage
forall x. XTerm PrettyStage -> Rep (XTerm PrettyStage) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XTerm PrettyStage -> Rep (XTerm PrettyStage) x
from :: forall x. XTerm PrettyStage -> Rep (XTerm PrettyStage) x
$cto :: forall x. Rep (XTerm PrettyStage) x -> XTerm PrettyStage
to :: forall x. Rep (XTerm PrettyStage) x -> XTerm PrettyStage
Generic, XTerm PrettyStage -> [Comment]
(XTerm PrettyStage -> [Comment])
-> CollectComments (XTerm PrettyStage)
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: XTerm PrettyStage -> [Comment]
collectComments :: XTerm PrettyStage -> [Comment]
CollectComments, NonEmpty (XTerm PrettyStage) -> XTerm PrettyStage
XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage
(XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage)
-> (NonEmpty (XTerm PrettyStage) -> XTerm PrettyStage)
-> (forall b.
    Integral b =>
    b -> XTerm PrettyStage -> XTerm PrettyStage)
-> Semigroup (XTerm PrettyStage)
forall b. Integral b => b -> XTerm PrettyStage -> XTerm PrettyStage
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage
<> :: XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage
$csconcat :: NonEmpty (XTerm PrettyStage) -> XTerm PrettyStage
sconcat :: NonEmpty (XTerm PrettyStage) -> XTerm PrettyStage
$cstimes :: forall b. Integral b => b -> XTerm PrettyStage -> XTerm PrettyStage
stimes :: forall b. Integral b => b -> XTerm PrettyStage -> XTerm PrettyStage
Semigroup, Semigroup (XTerm PrettyStage)
XTerm PrettyStage
Semigroup (XTerm PrettyStage) =>
XTerm PrettyStage
-> (XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage)
-> ([XTerm PrettyStage] -> XTerm PrettyStage)
-> Monoid (XTerm PrettyStage)
[XTerm PrettyStage] -> XTerm PrettyStage
XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: XTerm PrettyStage
mempty :: XTerm PrettyStage
$cmappend :: XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage
mappend :: XTerm PrettyStage -> XTerm PrettyStage -> XTerm PrettyStage
$cmconcat :: [XTerm PrettyStage] -> XTerm PrettyStage
mconcat :: [XTerm PrettyStage] -> XTerm PrettyStage
Monoid, String -> XTerm PrettyStage
(String -> XTerm PrettyStage) -> IsString (XTerm PrettyStage)
forall a. (String -> a) -> IsString a
$cfromString :: String -> XTerm PrettyStage
fromString :: String -> XTerm PrettyStage
IsString, [XTerm PrettyStage] -> Expr
XTerm PrettyStage -> Expr
(XTerm PrettyStage -> Expr)
-> ([XTerm PrettyStage] -> Expr) -> ToExpr (XTerm PrettyStage)
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: XTerm PrettyStage -> Expr
toExpr :: XTerm PrettyStage -> Expr
$clistToExpr :: [XTerm PrettyStage] -> Expr
listToExpr :: [XTerm PrettyStage] -> Expr
ToExpr, Int -> XTerm PrettyStage -> ShowS
[XTerm PrettyStage] -> ShowS
XTerm PrettyStage -> String
(Int -> XTerm PrettyStage -> ShowS)
-> (XTerm PrettyStage -> String)
-> ([XTerm PrettyStage] -> ShowS)
-> Show (XTerm PrettyStage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XTerm PrettyStage -> ShowS
showsPrec :: Int -> XTerm PrettyStage -> ShowS
$cshow :: XTerm PrettyStage -> String
show :: XTerm PrettyStage -> String
$cshowList :: [XTerm PrettyStage] -> ShowS
showList :: [XTerm PrettyStage] -> ShowS
Show, XTerm PrettyStage -> XTerm PrettyStage -> Bool
(XTerm PrettyStage -> XTerm PrettyStage -> Bool)
-> (XTerm PrettyStage -> XTerm PrettyStage -> Bool)
-> Eq (XTerm PrettyStage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XTerm PrettyStage -> XTerm PrettyStage -> Bool
== :: XTerm PrettyStage -> XTerm PrettyStage -> Bool
$c/= :: XTerm PrettyStage -> XTerm PrettyStage -> Bool
/= :: XTerm PrettyStage -> XTerm PrettyStage -> Bool
Eq)

newtype instance XCddl PrettyStage = PrettyXCddl [Comment]
  deriving ((forall x. XCddl PrettyStage -> Rep (XCddl PrettyStage) x)
-> (forall x. Rep (XCddl PrettyStage) x -> XCddl PrettyStage)
-> Generic (XCddl PrettyStage)
forall x. Rep (XCddl PrettyStage) x -> XCddl PrettyStage
forall x. XCddl PrettyStage -> Rep (XCddl PrettyStage) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XCddl PrettyStage -> Rep (XCddl PrettyStage) x
from :: forall x. XCddl PrettyStage -> Rep (XCddl PrettyStage) x
$cto :: forall x. Rep (XCddl PrettyStage) x -> XCddl PrettyStage
to :: forall x. Rep (XCddl PrettyStage) x -> XCddl PrettyStage
Generic, XCddl PrettyStage -> [Comment]
(XCddl PrettyStage -> [Comment])
-> CollectComments (XCddl PrettyStage)
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: XCddl PrettyStage -> [Comment]
collectComments :: XCddl PrettyStage -> [Comment]
CollectComments, [XCddl PrettyStage] -> Expr
XCddl PrettyStage -> Expr
(XCddl PrettyStage -> Expr)
-> ([XCddl PrettyStage] -> Expr) -> ToExpr (XCddl PrettyStage)
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: XCddl PrettyStage -> Expr
toExpr :: XCddl PrettyStage -> Expr
$clistToExpr :: [XCddl PrettyStage] -> Expr
listToExpr :: [XCddl PrettyStage] -> Expr
ToExpr, Int -> XCddl PrettyStage -> ShowS
[XCddl PrettyStage] -> ShowS
XCddl PrettyStage -> String
(Int -> XCddl PrettyStage -> ShowS)
-> (XCddl PrettyStage -> String)
-> ([XCddl PrettyStage] -> ShowS)
-> Show (XCddl PrettyStage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XCddl PrettyStage -> ShowS
showsPrec :: Int -> XCddl PrettyStage -> ShowS
$cshow :: XCddl PrettyStage -> String
show :: XCddl PrettyStage -> String
$cshowList :: [XCddl PrettyStage] -> ShowS
showList :: [XCddl PrettyStage] -> ShowS
Show, XCddl PrettyStage -> XCddl PrettyStage -> Bool
(XCddl PrettyStage -> XCddl PrettyStage -> Bool)
-> (XCddl PrettyStage -> XCddl PrettyStage -> Bool)
-> Eq (XCddl PrettyStage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XCddl PrettyStage -> XCddl PrettyStage -> Bool
== :: XCddl PrettyStage -> XCddl PrettyStage -> Bool
$c/= :: XCddl PrettyStage -> XCddl PrettyStage -> Bool
/= :: XCddl PrettyStage -> XCddl PrettyStage -> Bool
Eq)

newtype instance XRule PrettyStage = PrettyXRule {XRule PrettyStage -> Comment
unPrettyXRule :: Comment}
  deriving ((forall x. XRule PrettyStage -> Rep (XRule PrettyStage) x)
-> (forall x. Rep (XRule PrettyStage) x -> XRule PrettyStage)
-> Generic (XRule PrettyStage)
forall x. Rep (XRule PrettyStage) x -> XRule PrettyStage
forall x. XRule PrettyStage -> Rep (XRule PrettyStage) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XRule PrettyStage -> Rep (XRule PrettyStage) x
from :: forall x. XRule PrettyStage -> Rep (XRule PrettyStage) x
$cto :: forall x. Rep (XRule PrettyStage) x -> XRule PrettyStage
to :: forall x. Rep (XRule PrettyStage) x -> XRule PrettyStage
Generic, XRule PrettyStage -> [Comment]
(XRule PrettyStage -> [Comment])
-> CollectComments (XRule PrettyStage)
forall a. (a -> [Comment]) -> CollectComments a
$ccollectComments :: XRule PrettyStage -> [Comment]
collectComments :: XRule PrettyStage -> [Comment]
CollectComments, [XRule PrettyStage] -> Expr
XRule PrettyStage -> Expr
(XRule PrettyStage -> Expr)
-> ([XRule PrettyStage] -> Expr) -> ToExpr (XRule PrettyStage)
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: XRule PrettyStage -> Expr
toExpr :: XRule PrettyStage -> Expr
$clistToExpr :: [XRule PrettyStage] -> Expr
listToExpr :: [XRule PrettyStage] -> Expr
ToExpr, Int -> XRule PrettyStage -> ShowS
[XRule PrettyStage] -> ShowS
XRule PrettyStage -> String
(Int -> XRule PrettyStage -> ShowS)
-> (XRule PrettyStage -> String)
-> ([XRule PrettyStage] -> ShowS)
-> Show (XRule PrettyStage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XRule PrettyStage -> ShowS
showsPrec :: Int -> XRule PrettyStage -> ShowS
$cshow :: XRule PrettyStage -> String
show :: XRule PrettyStage -> String
$cshowList :: [XRule PrettyStage] -> ShowS
showList :: [XRule PrettyStage] -> ShowS
Show, XRule PrettyStage -> XRule PrettyStage -> Bool
(XRule PrettyStage -> XRule PrettyStage -> Bool)
-> (XRule PrettyStage -> XRule PrettyStage -> Bool)
-> Eq (XRule PrettyStage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XRule PrettyStage -> XRule PrettyStage -> Bool
== :: XRule PrettyStage -> XRule PrettyStage -> Bool
$c/= :: XRule PrettyStage -> XRule PrettyStage -> Bool
/= :: XRule PrettyStage -> XRule PrettyStage -> Bool
Eq)
  deriving newtype (XRule PrettyStage
XRule PrettyStage -> Default (XRule PrettyStage)
forall a. a -> Default a
$cdef :: XRule PrettyStage
def :: XRule PrettyStage
Default)

instance HasComment (XTerm PrettyStage) where
  commentL :: Lens' (XTerm PrettyStage) Comment
commentL = Lens' (XTerm PrettyStage) Comment
#unPrettyXTerm

instance HasComment (XRule PrettyStage) where
  commentL :: Lens' (XRule PrettyStage) Comment
commentL = Lens' (XRule PrettyStage) Comment
#unPrettyXRule

instance Pretty (CDDL PrettyStage) where
  pretty :: forall ann. CDDL PrettyStage -> Doc ann
pretty = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> (CDDL PrettyStage -> [Doc ann]) -> CDDL PrettyStage -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TopLevel PrettyStage -> Doc ann)
-> [TopLevel PrettyStage] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TopLevel PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TopLevel PrettyStage -> Doc ann
pretty ([TopLevel PrettyStage] -> [Doc ann])
-> (CDDL PrettyStage -> [TopLevel PrettyStage])
-> CDDL PrettyStage
-> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (TopLevel PrettyStage) -> [TopLevel PrettyStage]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (TopLevel PrettyStage) -> [TopLevel PrettyStage])
-> (CDDL PrettyStage -> NonEmpty (TopLevel PrettyStage))
-> CDDL PrettyStage
-> [TopLevel PrettyStage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDDL PrettyStage -> NonEmpty (TopLevel PrettyStage)
forall i. CDDL i -> NonEmpty (TopLevel i)
cddlTopLevel

instance Pretty (TopLevel PrettyStage) where
  pretty :: forall ann. TopLevel PrettyStage -> Doc ann
pretty (XXTopLevel (PrettyXXTopLevel Comment
cmt)) = Comment -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Comment -> Doc ann
pretty Comment
cmt
  pretty (TopLevelRule Rule PrettyStage
x) = Rule PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Rule PrettyStage -> Doc ann
pretty Rule PrettyStage
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

instance Pretty Name where
  pretty :: forall ann. Name -> Doc ann
pretty (Name Text
name) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
name

data CommentRender
  = PreComment
  | PostComment

prettyCommentNoBreak :: Comment -> Doc ann
prettyCommentNoBreak :: forall ann. Comment -> Doc ann
prettyCommentNoBreak = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> (Comment -> Doc ann) -> Comment -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> (Comment -> [Doc ann]) -> Comment -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> [Doc ann]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Doc ann] -> [Doc ann])
-> (Comment -> [Doc ann]) -> Comment -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (Text -> Text) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"; " <>)) ([Text] -> [Doc ann])
-> (Comment -> [Text]) -> Comment -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> [Text]
unComment

prettyCommentNoBreakWS :: Comment -> Doc ann
prettyCommentNoBreakWS :: forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt
  | Comment
cmt Comment -> Comment -> Bool
forall a. Eq a => a -> a -> Bool
== Comment
forall a. Monoid a => a
mempty = Doc ann
forall a. Monoid a => a
mempty
  | Bool
otherwise = Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreak Comment
cmt

instance Pretty Comment where
  pretty :: forall ann. Comment -> Doc ann
pretty (Comment Text
"") = Doc ann
forall a. Monoid a => a
mempty
  pretty Comment
c = Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreak Comment
c Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

type0Def :: Type0 PrettyStage -> Doc ann
type0Def :: forall ann. Type0 PrettyStage -> Doc ann
type0Def Type0 PrettyStage
t = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
forall ann. Doc ann
line' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type0 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 PrettyStage -> Doc ann
pretty Type0 PrettyStage
t

instance Pretty (Rule PrettyStage) where
  pretty :: forall ann. Rule PrettyStage -> Doc ann
pretty (Rule Name
n Maybe (GenericParameters PrettyStage)
mgen Assign
assign TypeOrGroup PrettyStage
tog XRule PrettyStage
cmt) =
    Comment -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Comment -> Doc ann
pretty (XRule PrettyStage
cmt XRule PrettyStage -> Lens' (XRule PrettyStage) Comment -> Comment
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' (XRule PrettyStage) Comment
forall a. HasComment a => Lens' a Comment
commentL)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeOrGroup PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments
        TypeOrGroup PrettyStage
tog
        ( Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (GenericParameters PrettyStage) -> Doc ann
forall ann. Maybe (GenericParameters PrettyStage) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (GenericParameters PrettyStage)
mgen Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> case TypeOrGroup PrettyStage
tog of
            TOGType Type0 PrettyStage
t -> Doc ann
ppAssignT Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type0 PrettyStage -> Doc ann
forall ann. Type0 PrettyStage -> Doc ann
type0Def Type0 PrettyStage
t
            TOGGroup GroupEntry PrettyStage
g -> Doc ann
ppAssignG Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann
forall ann. Doc ann
line' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> GroupEntry PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. GroupEntry PrettyStage -> Doc ann
pretty GroupEntry PrettyStage
g)
        )
    where
      ppAssignT :: Doc ann
ppAssignT = case Assign
assign of
        Assign
AssignEq -> Doc ann
"="
        Assign
AssignExt -> Doc ann
"/="
      ppAssignG :: Doc ann
ppAssignG = case Assign
assign of
        Assign
AssignEq -> Doc ann
"="
        Assign
AssignExt -> Doc ann
"//="

instance Pretty (GenericArg PrettyStage) where
  pretty :: forall ann. GenericArg PrettyStage -> Doc ann
pretty (GenericArg (NonEmpty (Type1 PrettyStage) -> [Type1 PrettyStage]
forall a. NonEmpty a -> [a]
NE.toList -> [Type1 PrettyStage]
l))
    | [Comment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Type1 PrettyStage] -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments [Type1 PrettyStage]
l) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
cEncloseSep Doc ann
"<" Doc ann
">" Doc ann
"," ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Type1 PrettyStage -> Doc ann) -> [Type1 PrettyStage] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type1 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type1 PrettyStage -> Doc ann
pretty [Type1 PrettyStage]
l
    | Bool
otherwise = Doc ann -> Doc ann -> Doc ann -> Columnar ann -> Doc ann
forall ann.
Doc ann -> Doc ann -> Doc ann -> Columnar ann -> Doc ann
columnarListing Doc ann
"<" Doc ann
">" Doc ann
"," (Columnar ann -> Doc ann)
-> ([Row ann] -> Columnar ann) -> [Row ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Row ann] -> Columnar ann
forall ann. [Row ann] -> Columnar ann
Columnar ([Row ann] -> Doc ann) -> [Row ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Row ann
forall ann. Doc ann -> Row ann
singletonRow (Doc ann -> Row ann)
-> (Type1 PrettyStage -> Doc ann) -> Type1 PrettyStage -> Row ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type1 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type1 PrettyStage -> Doc ann
pretty (Type1 PrettyStage -> Row ann) -> [Type1 PrettyStage] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type1 PrettyStage]
l

instance Pretty (GenericParameter PrettyStage) where
  pretty :: forall ann. GenericParameter PrettyStage -> Doc ann
pretty (GenericParameter Name
n (PrettyXTerm Comment
c)) = Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
c

instance Pretty (GenericParameters PrettyStage) where
  pretty :: forall ann. GenericParameters PrettyStage -> Doc ann
pretty (GenericParameters (NonEmpty (GenericParameter PrettyStage)
-> [GenericParameter PrettyStage]
forall a. NonEmpty a -> [a]
NE.toList -> [GenericParameter PrettyStage]
l))
    | [Comment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenericParameter PrettyStage] -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments [GenericParameter PrettyStage]
l) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
cEncloseSep Doc ann
"<" Doc ann
">" Doc ann
"," ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ GenericParameter PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. GenericParameter PrettyStage -> Doc ann
pretty (GenericParameter PrettyStage -> Doc ann)
-> [GenericParameter PrettyStage] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenericParameter PrettyStage]
l
    | Bool
otherwise = Doc ann -> Doc ann -> Doc ann -> Columnar ann -> Doc ann
forall ann.
Doc ann -> Doc ann -> Doc ann -> Columnar ann -> Doc ann
columnarListing Doc ann
"<" Doc ann
">" Doc ann
"," (Columnar ann -> Doc ann)
-> ([Row ann] -> Columnar ann) -> [Row ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Row ann] -> Columnar ann
forall ann. [Row ann] -> Columnar ann
Columnar ([Row ann] -> Doc ann) -> [Row ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Row ann
forall ann. Doc ann -> Row ann
singletonRow (Doc ann -> Row ann)
-> (GenericParameter PrettyStage -> Doc ann)
-> GenericParameter PrettyStage
-> Row ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericParameter PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. GenericParameter PrettyStage -> Doc ann
pretty (GenericParameter PrettyStage -> Row ann)
-> [GenericParameter PrettyStage] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenericParameter PrettyStage]
l

instance Pretty (Type0 PrettyStage) where
  pretty :: forall ann. Type0 PrettyStage -> Doc ann
pretty t0 :: Type0 PrettyStage
t0@(Type0 (NonEmpty (Type1 PrettyStage) -> [Type1 PrettyStage]
forall a. NonEmpty a -> [a]
NE.toList -> [Type1 PrettyStage]
l)) =
    Type0 PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type0 PrettyStage
t0 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Columnar ann -> Doc ann
forall ann. Doc ann -> Columnar ann -> Doc ann
columnarSepBy Doc ann
"/" (Columnar ann -> Doc ann)
-> ([Row ann] -> Columnar ann) -> [Row ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Row ann] -> Columnar ann
forall ann. [Row ann] -> Columnar ann
Columnar ([Row ann] -> Doc ann) -> [Row ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Type1 PrettyStage -> Row ann
forall {ann}. Type1 PrettyStage -> Row ann
type1ToRow (Type1 PrettyStage -> Row ann) -> [Type1 PrettyStage] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type1 PrettyStage]
l
    where
      type1ToRow :: Type1 PrettyStage -> Row ann
type1ToRow (Type1 Type2 PrettyStage
t2 Maybe (TyOp, Type2 PrettyStage)
tyOp (PrettyXTerm Comment
cmt)) =
        let
          valCell :: Cell ann
valCell = case Maybe (TyOp, Type2 PrettyStage)
tyOp of
            Maybe (TyOp, Type2 PrettyStage)
Nothing -> Type2 PrettyStage -> Cell ann
forall a ann. Pretty a => a -> Cell ann
cellL Type2 PrettyStage
t2
            Just (TyOp
to, Type2 PrettyStage
t2') -> Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (Type2 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 PrettyStage -> Doc ann
pretty Type2 PrettyStage
t2 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TyOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TyOp -> Doc ann
pretty TyOp
to Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type2 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 PrettyStage -> Doc ann
pretty Type2 PrettyStage
t2') CellAlign
LeftAlign
         in
          [Cell ann] -> Row ann
forall ann. [Cell ann] -> Row ann
Row [Cell ann
valCell, Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt) CellAlign
LeftAlign]

instance Pretty CtlOp where
  pretty :: forall ann. CtlOp -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (CtlOp -> Text) -> CtlOp -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (CtlOp -> Text) -> CtlOp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (CtlOp -> String) -> CtlOp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtlOp -> String
forall a. Show a => a -> String
show

instance Pretty TyOp where
  pretty :: forall ann. TyOp -> Doc ann
pretty (RangeOp RangeBound
ClOpen) = Doc ann
"..."
  pretty (RangeOp RangeBound
Closed) = Doc ann
".."
  pretty (CtrlOp CtlOp
n) = Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CtlOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CtlOp -> Doc ann
pretty CtlOp
n

instance Pretty (Type1 PrettyStage) where
  pretty :: forall ann. Type1 PrettyStage -> Doc ann
pretty (Type1 Type2 PrettyStage
t2 Maybe (TyOp, Type2 PrettyStage)
Nothing (PrettyXTerm Comment
cmt)) = Type2 PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type2 PrettyStage
t2 (Type2 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 PrettyStage -> Doc ann
pretty Type2 PrettyStage
t2) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt
  pretty (Type1 Type2 PrettyStage
t2 (Just (TyOp
tyop, Type2 PrettyStage
t2')) (PrettyXTerm Comment
cmt)) =
    Type2 PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type2 PrettyStage
t2 (Type2 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 PrettyStage -> Doc ann
pretty Type2 PrettyStage
t2)
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TyOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TyOp -> Doc ann
pretty TyOp
tyop
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type2 PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type2 PrettyStage
t2' (Type2 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 PrettyStage -> Doc ann
pretty Type2 PrettyStage
t2')
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt

instance Pretty (Type2 PrettyStage) where
  pretty :: forall ann. Type2 PrettyStage -> Doc ann
pretty (T2Value Value
v) = Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Value -> Doc ann
pretty Value
v
  pretty (T2Name Name
n Maybe (GenericArg PrettyStage)
mg) = Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (GenericArg PrettyStage) -> Doc ann
forall ann. Maybe (GenericArg PrettyStage) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (GenericArg PrettyStage)
mg
  pretty (T2Group Type0 PrettyStage
g) = Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
cEncloseSep Doc ann
"(" Doc ann
")" Doc ann
forall a. Monoid a => a
mempty [Type0 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 PrettyStage -> Doc ann
pretty Type0 PrettyStage
g]
  pretty (T2Map Group PrettyStage
g) = GroupRender -> Group PrettyStage -> Doc ann
forall ann. GroupRender -> Group PrettyStage -> Doc ann
prettyGroup GroupRender
AsMap Group PrettyStage
g
  pretty (T2Array Group PrettyStage
g) = GroupRender -> Group PrettyStage -> Doc ann
forall ann. GroupRender -> Group PrettyStage -> Doc ann
prettyGroup GroupRender
AsArray Group PrettyStage
g
  pretty (T2Unwrapped Name
n Maybe (GenericArg PrettyStage)
mg) = Doc ann
"~" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (GenericArg PrettyStage) -> Doc ann
forall ann. Maybe (GenericArg PrettyStage) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (GenericArg PrettyStage)
mg
  pretty (T2Enum Group PrettyStage
g) = Doc ann
"&" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> GroupRender -> Group PrettyStage -> Doc ann
forall ann. GroupRender -> Group PrettyStage -> Doc ann
prettyGroup GroupRender
AsGroup Group PrettyStage
g
  pretty (T2EnumRef Name
g Maybe (GenericArg PrettyStage)
mg) = Doc ann
"&" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
g Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (GenericArg PrettyStage) -> Doc ann
forall ann. Maybe (GenericArg PrettyStage) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (GenericArg PrettyStage)
mg
  pretty (T2Tag Maybe Word64
minor Type0 PrettyStage
t) = Doc ann
"#6" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
min' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose Doc ann
"(" Doc ann
")" (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann
forall ann. Doc ann
line' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type0 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 PrettyStage -> Doc ann
pretty Type0 PrettyStage
t) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line')
    where
      min' :: Doc ann
min' = case Maybe Word64
minor of
        Maybe Word64
Nothing -> Doc ann
forall a. Monoid a => a
mempty
        Just Word64
m -> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc ann
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
m
  pretty (T2DataItem Word8
major Maybe Word64
mminor) =
    Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word8 -> Doc ann
forall ann. Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
major Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> case Maybe Word64
mminor of
      Maybe Word64
Nothing -> Doc ann
forall a. Monoid a => a
mempty
      Just Word64
minor -> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc ann
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
minor
  pretty Type2 PrettyStage
T2Any = Doc ann
"#"
  pretty (XXType2 (PrettyXXType2 Void
v)) = Void -> Doc ann
forall a. Void -> a
absurd Void
v

instance Pretty OccurrenceIndicator where
  pretty :: forall ann. OccurrenceIndicator -> Doc ann
pretty OccurrenceIndicator
OIOptional = Doc ann
"?"
  pretty OccurrenceIndicator
OIZeroOrMore = Doc ann
"*"
  pretty OccurrenceIndicator
OIOneOrMore = Doc ann
"+"
  pretty (OIBounded Maybe Word64
ml Maybe Word64
mh) = Maybe Word64 -> Doc ann
forall ann. Maybe Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe Word64
ml Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"*" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe Word64 -> Doc ann
forall ann. Maybe Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe Word64
mh

-- | Control how to render a group
data GroupRender
  = AsMap
  | AsArray
  | AsGroup

memberKeySep :: MemberKey i -> Doc ann
memberKeySep :: forall i ann. MemberKey i -> Doc ann
memberKeySep MKType {} = Doc ann
" => "
memberKeySep MemberKey i
_ = Doc ann
" : "

cEncloseSep :: Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
cEncloseSep :: forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
cEncloseSep Doc ann
lEnc Doc ann
rEnc Doc ann
_ [] = Doc ann
lEnc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
rEnc
cEncloseSep Doc ann
lEnc Doc ann
rEnc Doc ann
_ [Doc ann
x] =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
    [ Doc ann
lEnc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softspace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x
    , Doc ann
rEnc
    ]
cEncloseSep Doc ann
lEnc Doc ann
rEnc Doc ann
s (Doc ann
h : [Doc ann]
tl) =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((Doc ann
lEnc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
lSpaces Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group Doc ann
h) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Doc ann -> Doc ann) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc ann
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space) <>) [Doc ann]
tl) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
rEnc
  where
    lSpaces :: Doc ann
lSpaces = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> [Doc ann]
forall a. Int -> a -> [a]
replicate (Doc ann -> Int
forall ann. Doc ann -> Int
renderedLen Doc ann
s) Doc ann
forall ann. Doc ann
softspace

groupIfNoComments :: CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments :: forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments a
x
  | Bool -> Bool
not ((Comment -> Bool) -> [Comment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Comment
forall a. Monoid a => a
mempty /=) ([Comment] -> Bool) -> [Comment] -> Bool
forall a b. (a -> b) -> a -> b
$ a -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments a
x) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group
  | Bool
otherwise = Doc ann -> Doc ann
forall a. a -> a
id

columnarGroupChoice :: GrpChoice PrettyStage -> Columnar ann
columnarGroupChoice :: forall ann. GrpChoice PrettyStage -> Columnar ann
columnarGroupChoice (GrpChoice [GroupEntry PrettyStage]
ges XTerm PrettyStage
_cmt) = [Row ann] -> Columnar ann
forall ann. [Row ann] -> Columnar ann
Columnar [Row ann]
grpEntryRows
  where
    groupEntryRow :: GroupEntry PrettyStage -> Row ann
groupEntryRow (GroupEntry Maybe OccurrenceIndicator
oi GroupEntryVariant PrettyStage
gev (PrettyXTerm Comment
cmt)) =
      [Cell ann] -> Row ann
forall ann. [Cell ann] -> Row ann
Row ([Cell ann] -> Row ann) -> [Cell ann] -> Row ann
forall a b. (a -> b) -> a -> b
$
        [Cell ann
-> (OccurrenceIndicator -> Cell ann)
-> Maybe OccurrenceIndicator
-> Cell ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Cell ann
forall ann. Cell ann
emptyCell (\OccurrenceIndicator
x -> Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (OccurrenceIndicator -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. OccurrenceIndicator -> Doc ann
pretty OccurrenceIndicator
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space) CellAlign
LeftAlign) Maybe OccurrenceIndicator
oi]
          [Cell ann] -> [Cell ann] -> [Cell ann]
forall a. Semigroup a => a -> a -> a
<> GroupEntryVariant PrettyStage -> [Cell ann]
forall {ann}. GroupEntryVariant PrettyStage -> [Cell ann]
groupEntryVariantCells GroupEntryVariant PrettyStage
gev
          [Cell ann] -> [Cell ann] -> [Cell ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt) CellAlign
LeftAlign]
    groupEntryVariantCells :: GroupEntryVariant PrettyStage -> [Cell ann]
groupEntryVariantCells (GERef Name
n Maybe (GenericArg PrettyStage)
ga) = [Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe (GenericArg PrettyStage) -> Doc ann
forall ann. Maybe (GenericArg PrettyStage) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe (GenericArg PrettyStage)
ga) CellAlign
LeftAlign]
    groupEntryVariantCells (GEType (Just MemberKey PrettyStage
mk) Type0 PrettyStage
t0) = [MemberKey PrettyStage -> Cell ann
forall a ann. Pretty a => a -> Cell ann
cellL MemberKey PrettyStage
mk, Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (MemberKey PrettyStage -> Doc ann
forall i ann. MemberKey i -> Doc ann
memberKeySep MemberKey PrettyStage
mk Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type0 PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type0 PrettyStage
t0 (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Type0 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 PrettyStage -> Doc ann
pretty Type0 PrettyStage
t0)) CellAlign
LeftAlign]
    groupEntryVariantCells (GEType Maybe (MemberKey PrettyStage)
Nothing Type0 PrettyStage
t0) = [Type0 PrettyStage -> Cell ann
forall a ann. Pretty a => a -> Cell ann
cellL Type0 PrettyStage
t0]
    groupEntryVariantCells (GEGroup Group PrettyStage
g) = [Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (GroupRender -> Group PrettyStage -> Doc ann
forall ann. GroupRender -> Group PrettyStage -> Doc ann
prettyGroup GroupRender
AsGroup Group PrettyStage
g) CellAlign
LeftAlign, Cell ann
forall ann. Cell ann
emptyCell]
    grpEntryRows :: [Row ann]
grpEntryRows = GroupEntry PrettyStage -> Row ann
forall {ann}. GroupEntry PrettyStage -> Row ann
groupEntryRow (GroupEntry PrettyStage -> Row ann)
-> [GroupEntry PrettyStage] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GroupEntry PrettyStage]
ges

prettyGroup :: GroupRender -> Group PrettyStage -> Doc ann
prettyGroup :: forall ann. GroupRender -> Group PrettyStage -> Doc ann
prettyGroup GroupRender
gr g :: Group PrettyStage
g@(Group (NonEmpty (GrpChoice PrettyStage) -> [GrpChoice PrettyStage]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [GrpChoice PrettyStage]
xs)) =
  Group PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Group PrettyStage
g (Doc ann -> Doc ann)
-> ([Row ann] -> Doc ann) -> [Row ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann -> Doc ann -> Columnar ann -> Doc ann
forall ann.
Doc ann -> Doc ann -> Doc ann -> Columnar ann -> Doc ann
columnarListing (Doc ann
lEnc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softspace) Doc ann
rEnc Doc ann
"// " (Columnar ann -> Doc ann)
-> ([Row ann] -> Columnar ann) -> [Row ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Row ann] -> Columnar ann
forall ann. [Row ann] -> Columnar ann
Columnar ([Row ann] -> Doc ann) -> [Row ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
    (\GrpChoice PrettyStage
x -> Doc ann -> Row ann
forall ann. Doc ann -> Row ann
singletonRow (Doc ann -> Row ann)
-> (Columnar ann -> Doc ann) -> Columnar ann -> Row ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrpChoice PrettyStage -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments GrpChoice PrettyStage
x (Doc ann -> Doc ann)
-> (Columnar ann -> Doc ann) -> Columnar ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Columnar ann -> Doc ann
forall ann. Doc ann -> Columnar ann -> Doc ann
columnarSepBy Doc ann
"," (Columnar ann -> Row ann) -> Columnar ann -> Row ann
forall a b. (a -> b) -> a -> b
$ GrpChoice PrettyStage -> Columnar ann
forall ann. GrpChoice PrettyStage -> Columnar ann
columnarGroupChoice GrpChoice PrettyStage
x) (GrpChoice PrettyStage -> Row ann)
-> [GrpChoice PrettyStage] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrpChoice PrettyStage]
xs
  where
    (Doc ann
lEnc, Doc ann
rEnc) = case GroupRender
gr of
      GroupRender
AsMap -> (Doc ann
"{", Doc ann
"}")
      GroupRender
AsArray -> (Doc ann
"[", Doc ann
"]")
      GroupRender
AsGroup -> (Doc ann
"(", Doc ann
")")

instance Pretty (GroupEntry PrettyStage) where
  pretty :: forall ann. GroupEntry PrettyStage -> Doc ann
pretty GroupEntry PrettyStage
ge = Columnar ann -> Doc ann
forall ann. Columnar ann -> Doc ann
prettyColumnar (Columnar ann -> Doc ann)
-> (GrpChoice PrettyStage -> Columnar ann)
-> GrpChoice PrettyStage
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrpChoice PrettyStage -> Columnar ann
forall ann. GrpChoice PrettyStage -> Columnar ann
columnarGroupChoice (GrpChoice PrettyStage -> Doc ann)
-> GrpChoice PrettyStage -> Doc ann
forall a b. (a -> b) -> a -> b
$ [GroupEntry PrettyStage]
-> XTerm PrettyStage -> GrpChoice PrettyStage
forall i. [GroupEntry i] -> XTerm i -> GrpChoice i
GrpChoice [GroupEntry PrettyStage
ge] XTerm PrettyStage
forall a. Monoid a => a
mempty

instance Pretty (MemberKey PrettyStage) where
  pretty :: forall ann. MemberKey PrettyStage -> Doc ann
pretty (MKType Type1 PrettyStage
t1) = Type1 PrettyStage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type1 PrettyStage -> Doc ann
pretty Type1 PrettyStage
t1
  pretty (MKBareword Name
n) = Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n
  pretty (MKValue Value
v) = Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Value -> Doc ann
pretty Value
v

instance Pretty Value where
  pretty :: forall ann. Value -> Doc ann
pretty (Value ValueVariant
v Comment
cmt) = ValueVariant -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ValueVariant -> Doc ann
pretty ValueVariant
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt

instance Pretty ValueVariant where
  pretty :: forall ann. ValueVariant -> Doc ann
pretty (VUInt Word64
i) = Word64 -> Doc ann
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
i
  pretty (VNInt Word64
i) = Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc ann
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
i
  pretty (VBignum Integer
i) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
  pretty (VFloat16 Float
i) = Float -> Doc ann
forall ann. Float -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Float
i
  pretty (VFloat32 Float
i) = Float -> Doc ann
forall ann. Float -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Float
i
  pretty (VFloat64 Double
i) = Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
i
  pretty (VText Text
t) = Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose Doc ann
"\"" Doc ann
"\"" (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
  pretty (VBytes ByteString
b) = String -> Doc ann
forall a. IsString a => String -> a
fromString (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ String
"h" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BS.unpack (ByteString -> ByteString
B16.encode ByteString
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
  pretty (VBool Bool
True) = Doc ann
"true"
  pretty (VBool Bool
False) = Doc ann
"false"