{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Codec.CBOR.Cuddle.Pretty where

import Codec.CBOR.Cuddle.CDDL
import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment (..), 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.Char8 qualified as BS
import Data.Foldable (Foldable (..))
import Data.List.NonEmpty qualified as NE
import Data.String (fromString)
import Data.Text qualified as T
import Prettyprinter

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

instance Pretty TopLevel where
  pretty :: forall ann. TopLevel -> Doc ann
pretty (TopLevelComment Comment
cmt) = Comment -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Comment -> Doc ann
pretty Comment
cmt
  pretty (TopLevelRule Rule
x) = Rule -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Rule -> Doc ann
pretty Rule
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 Comment
cmt) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Comment -> Doc ann
forall ann. Comment -> Doc ann
prettyCommentNoBreakWS Comment
cmt

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 -> Doc ann
type0Def :: forall ann. Type0 -> Doc ann
type0Def Type0
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 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 -> Doc ann
pretty Type0
t

instance Pretty Rule where
  pretty :: forall ann. Rule -> Doc ann
pretty (Rule Name
n Maybe GenericParam
mgen Assign
assign TypeOrGroup
tog Comment
cmt) =
    Comment -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Comment -> Doc ann
pretty Comment
cmt
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeOrGroup -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments
        TypeOrGroup
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 GenericParam -> Doc ann
forall ann. Maybe GenericParam -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe GenericParam
mgen Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> case TypeOrGroup
tog of
            TOGType Type0
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 -> Doc ann
forall ann. Type0 -> Doc ann
type0Def Type0
t
            TOGGroup GroupEntry
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 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. GroupEntry -> Doc ann
pretty GroupEntry
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 where
  pretty :: forall ann. GenericArg -> Doc ann
pretty (GenericArg (NonEmpty Type1 -> [Type1]
forall a. NonEmpty a -> [a]
NE.toList -> [Type1]
l))
    | [Comment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Type1] -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments [Type1]
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 -> Doc ann) -> [Type1] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type1 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type1 -> Doc ann
pretty [Type1]
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 -> Doc ann) -> Type1 -> Row ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type1 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type1 -> Doc ann
pretty (Type1 -> Row ann) -> [Type1] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type1]
l

instance Pretty GenericParam where
  pretty :: forall ann. GenericParam -> Doc ann
pretty (GenericParam (NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
NE.toList -> [Name]
l))
    | [Comment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name] -> [Comment]
forall a. CollectComments a => a -> [Comment]
collectComments [Name]
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
$ (Name -> Doc ann) -> [Name] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty [Name]
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) -> (Name -> Doc ann) -> Name -> Row ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty (Name -> Row ann) -> [Name] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
l

instance Pretty Type0 where
  pretty :: forall ann. Type0 -> Doc ann
pretty t0 :: Type0
t0@(Type0 (NonEmpty Type1 -> [Type1]
forall a. NonEmpty a -> [a]
NE.toList -> [Type1]
l)) =
    Type0 -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type0
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 -> Row ann
forall {ann}. Type1 -> Row ann
type1ToRow (Type1 -> Row ann) -> [Type1] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type1]
l
    where
      type1ToRow :: Type1 -> Row ann
type1ToRow (Type1 Type2
t2 Maybe (TyOp, Type2)
tyOp Comment
cmt) =
        let
          valCell :: Cell ann
valCell = case Maybe (TyOp, Type2)
tyOp of
            Maybe (TyOp, Type2)
Nothing -> Type2 -> Cell ann
forall a ann. Pretty a => a -> Cell ann
cellL Type2
t2
            Just (TyOp
to, Type2
t2') -> Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (Type2 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 -> Doc ann
pretty Type2
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 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 -> Doc ann
pretty Type2
t2') CellAlign
LeftAlign
         in
          [Cell ann] -> Row ann
forall ann. [Cell ann] -> Row ann
Row [Cell ann
forall {ann}. 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 where
  pretty :: forall ann. Type1 -> Doc ann
pretty (Type1 Type2
t2 Maybe (TyOp, Type2)
Nothing Comment
cmt) = Type2 -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type2
t2 (Type2 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 -> Doc ann
pretty Type2
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
t2 (Just (TyOp
tyop, Type2
t2')) Comment
cmt) =
    Type2 -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type2
t2 (Type2 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 -> Doc ann
pretty Type2
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 -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type2
t2' (Type2 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type2 -> Doc ann
pretty Type2
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 where
  pretty :: forall ann. Type2 -> 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
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 -> Doc ann
forall ann. Maybe GenericArg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe GenericArg
mg
  pretty (T2Group Type0
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 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 -> Doc ann
pretty Type0
g]
  pretty (T2Map Group
g) = GroupRender -> Group -> Doc ann
forall ann. GroupRender -> Group -> Doc ann
prettyGroup GroupRender
AsMap Group
g
  pretty (T2Array Group
g) = GroupRender -> Group -> Doc ann
forall ann. GroupRender -> Group -> Doc ann
prettyGroup GroupRender
AsArray Group
g
  pretty (T2Unwrapped Name
n Maybe GenericArg
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 -> Doc ann
forall ann. Maybe GenericArg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe GenericArg
mg
  pretty (T2Enum Group
g) = Doc ann
"&" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> GroupRender -> Group -> Doc ann
forall ann. GroupRender -> Group -> Doc ann
prettyGroup GroupRender
AsGroup Group
g
  pretty (T2EnumRef Name
g Maybe GenericArg
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 -> Doc ann
forall ann. Maybe GenericArg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe GenericArg
mg
  pretty (T2Tag Maybe Word64
minor Type0
t) = Doc ann
"#6" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. 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 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 -> Doc ann
pretty Type0
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
T2Any = Doc ann
"#"

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 -> Doc ann
memberKeySep :: forall ann. MemberKey -> Doc ann
memberKeySep MKType {} = Doc ann
" => "
memberKeySep MemberKey
_ = 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
forall ann. 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 -> Columnar ann
columnarGroupChoice :: forall ann. GrpChoice -> Columnar ann
columnarGroupChoice (GrpChoice [GroupEntry]
ges Comment
_cmt) = [Row ann] -> Columnar ann
forall ann. [Row ann] -> Columnar ann
Columnar [Row ann]
forall {ann}. [Row ann]
grpEntryRows
  where
    groupEntryRow :: GroupEntry -> Row ann
groupEntryRow (GroupEntry Maybe OccurrenceIndicator
oi Comment
cmt GroupEntryVariant
gev) =
      [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 -> [Cell ann]
forall {ann}. GroupEntryVariant -> [Cell ann]
groupEntryVariantCells GroupEntryVariant
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 -> [Cell ann]
groupEntryVariantCells (GERef Name
n Maybe GenericArg
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 -> Doc ann
forall ann. Maybe GenericArg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe GenericArg
ga) CellAlign
LeftAlign]
    groupEntryVariantCells (GEType (Just MemberKey
mk) Type0
t0) = [MemberKey -> Cell ann
forall a ann. Pretty a => a -> Cell ann
cellL MemberKey
mk, Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (MemberKey -> Doc ann
forall ann. MemberKey -> Doc ann
memberKeySep MemberKey
mk Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type0 -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Type0
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 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type0 -> Doc ann
pretty Type0
t0)) CellAlign
LeftAlign]
    groupEntryVariantCells (GEType Maybe MemberKey
Nothing Type0
t0) = [Type0 -> Cell ann
forall a ann. Pretty a => a -> Cell ann
cellL Type0
t0]
    groupEntryVariantCells (GEGroup Group
g) = [Doc ann -> CellAlign -> Cell ann
forall ann. Doc ann -> CellAlign -> Cell ann
Cell (GroupRender -> Group -> Doc ann
forall ann. GroupRender -> Group -> Doc ann
prettyGroup GroupRender
AsGroup Group
g) CellAlign
LeftAlign, Cell ann
forall {ann}. Cell ann
emptyCell]
    grpEntryRows :: [Row ann]
grpEntryRows = GroupEntry -> Row ann
forall {ann}. GroupEntry -> Row ann
groupEntryRow (GroupEntry -> Row ann) -> [GroupEntry] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GroupEntry]
ges

prettyGroup :: GroupRender -> Group -> Doc ann
prettyGroup :: forall ann. GroupRender -> Group -> Doc ann
prettyGroup GroupRender
gr g :: Group
g@(Group (NonEmpty GrpChoice -> [GrpChoice]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [GrpChoice]
xs)) =
  Group -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments Group
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
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 -> Doc ann -> Doc ann
forall a ann. CollectComments a => a -> Doc ann -> Doc ann
groupIfNoComments GrpChoice
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 -> Columnar ann
forall ann. GrpChoice -> Columnar ann
columnarGroupChoice GrpChoice
x) (GrpChoice -> Row ann) -> [GrpChoice] -> [Row ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrpChoice]
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 where
  pretty :: forall ann. GroupEntry -> Doc ann
pretty GroupEntry
ge = Columnar ann -> Doc ann
forall ann. Columnar ann -> Doc ann
prettyColumnar (Columnar ann -> Doc ann)
-> (GrpChoice -> Columnar ann) -> GrpChoice -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrpChoice -> Columnar ann
forall ann. GrpChoice -> Columnar ann
columnarGroupChoice (GrpChoice -> Doc ann) -> GrpChoice -> Doc ann
forall a b. (a -> b) -> a -> b
$ [GroupEntry] -> Comment -> GrpChoice
GrpChoice [GroupEntry
ge] Comment
forall a. Monoid a => a
mempty

instance Pretty MemberKey where
  pretty :: forall ann. MemberKey -> Doc ann
pretty (MKType Type1
t1) = Type1 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Type1 -> Doc ann
pretty Type1
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 -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BS.unpack ByteString
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
  pretty (VBool Bool
True) = Doc ann
"true"
  pretty (VBool Bool
False) = Doc ann
"false"