module Prettyprinter.MetaDoc
( DocKind(..)
, MetaDoc
, mdPayload
, mdKind
, compositeMetaDoc
, atomicMetaDoc
, metaDocInt
, metaDocFloat
, metaDocDouble
, metaDocInteger
, metaDocNatural
, metaDocWord
, metaDocWord8
, metaDocWord16
, metaDocWord32
, metaDocWord64
, metaDocInt8
, metaDocInt16
, metaDocInt32
, metaDocInt64
, metaDocUnit
, metaDocBool
, metaDocChar
, stringMetaDoc
, strictTextMetaDoc
, lazyTextMetaDoc
, strictByteStringMetaDoc
, lazyByteStringMetaDoc
, shortByteStringMetaDoc
, constructorAppMetaDoc
) where
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Lazy.Char8 qualified as CL8
import Data.ByteString.Short qualified as ShortBS
import Data.Int
import Data.Semigroup as Semigroup
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Word
import Numeric.Natural
import Prettyprinter
import Prettyprinter qualified as PP
import Prettyprinter.Combinators.Basic
data DocKind = Atomic | Composite
deriving (DocKind -> DocKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocKind -> DocKind -> Bool
$c/= :: DocKind -> DocKind -> Bool
== :: DocKind -> DocKind -> Bool
$c== :: DocKind -> DocKind -> Bool
Eq, Eq DocKind
DocKind -> DocKind -> Bool
DocKind -> DocKind -> Ordering
DocKind -> DocKind -> DocKind
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
min :: DocKind -> DocKind -> DocKind
$cmin :: DocKind -> DocKind -> DocKind
max :: DocKind -> DocKind -> DocKind
$cmax :: DocKind -> DocKind -> DocKind
>= :: DocKind -> DocKind -> Bool
$c>= :: DocKind -> DocKind -> Bool
> :: DocKind -> DocKind -> Bool
$c> :: DocKind -> DocKind -> Bool
<= :: DocKind -> DocKind -> Bool
$c<= :: DocKind -> DocKind -> Bool
< :: DocKind -> DocKind -> Bool
$c< :: DocKind -> DocKind -> Bool
compare :: DocKind -> DocKind -> Ordering
$ccompare :: DocKind -> DocKind -> Ordering
Ord, Int -> DocKind
DocKind -> Int
DocKind -> [DocKind]
DocKind -> DocKind
DocKind -> DocKind -> [DocKind]
DocKind -> DocKind -> DocKind -> [DocKind]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DocKind -> DocKind -> DocKind -> [DocKind]
$cenumFromThenTo :: DocKind -> DocKind -> DocKind -> [DocKind]
enumFromTo :: DocKind -> DocKind -> [DocKind]
$cenumFromTo :: DocKind -> DocKind -> [DocKind]
enumFromThen :: DocKind -> DocKind -> [DocKind]
$cenumFromThen :: DocKind -> DocKind -> [DocKind]
enumFrom :: DocKind -> [DocKind]
$cenumFrom :: DocKind -> [DocKind]
fromEnum :: DocKind -> Int
$cfromEnum :: DocKind -> Int
toEnum :: Int -> DocKind
$ctoEnum :: Int -> DocKind
pred :: DocKind -> DocKind
$cpred :: DocKind -> DocKind
succ :: DocKind -> DocKind
$csucc :: DocKind -> DocKind
Enum, DocKind
forall a. a -> a -> Bounded a
maxBound :: DocKind
$cmaxBound :: DocKind
minBound :: DocKind
$cminBound :: DocKind
Bounded)
instance Semigroup DocKind where
<> :: DocKind -> DocKind -> DocKind
(<>) = forall a. Ord a => a -> a -> a
max
instance Monoid DocKind where
mempty :: DocKind
mempty = forall a. Bounded a => a
minBound
mappend :: DocKind -> DocKind -> DocKind
mappend = forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
data MetaDoc ann = MetaDoc
{ forall ann. MetaDoc ann -> Doc ann
mdPayload :: Doc ann
, forall ann. MetaDoc ann -> DocKind
mdKind :: DocKind
}
compositeMetaDoc :: Doc ann -> MetaDoc ann
compositeMetaDoc :: forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc Doc ann
x = MetaDoc
{ mdPayload :: Doc ann
mdPayload = Doc ann
x
, mdKind :: DocKind
mdKind = DocKind
Composite
}
atomicMetaDoc :: Doc ann -> MetaDoc ann
atomicMetaDoc :: forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc Doc ann
x = MetaDoc
{ mdPayload :: Doc ann
mdPayload = Doc ann
x
, mdKind :: DocKind
mdKind = DocKind
Atomic
}
instance Semigroup (MetaDoc ann) where
<> :: MetaDoc ann -> MetaDoc ann -> MetaDoc ann
(<>) (MetaDoc Doc ann
p1 DocKind
kind1) (MetaDoc Doc ann
p2 DocKind
kind2) = MetaDoc
{ mdPayload :: Doc ann
mdPayload = Doc ann
p1 forall a. Semigroup a => a -> a -> a
<> Doc ann
p2
, mdKind :: DocKind
mdKind = DocKind
kind1 forall a. Semigroup a => a -> a -> a
<> DocKind
kind2
}
instance Monoid (MetaDoc ann) where
mempty :: MetaDoc ann
mempty = MetaDoc
{ mdPayload :: Doc ann
mdPayload = forall a. Monoid a => a
mempty
, mdKind :: DocKind
mdKind = forall a. Monoid a => a
mempty
}
mappend :: MetaDoc ann -> MetaDoc ann -> MetaDoc ann
mappend = forall a. Semigroup a => a -> a -> a
(<>)
metaDocInt :: Int -> MetaDoc ann
metaDocInt :: forall ann. Int -> MetaDoc ann
metaDocInt = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocFloat :: Float -> MetaDoc ann
metaDocFloat :: forall ann. Float -> MetaDoc ann
metaDocFloat = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocDouble :: Double -> MetaDoc ann
metaDocDouble :: forall ann. Double -> MetaDoc ann
metaDocDouble = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocInteger :: Integer -> MetaDoc ann
metaDocInteger :: forall ann. Integer -> MetaDoc ann
metaDocInteger = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocNatural :: Natural -> MetaDoc ann
metaDocNatural :: forall ann. Natural -> MetaDoc ann
metaDocNatural = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocWord :: Word -> MetaDoc ann
metaDocWord :: forall ann. Word -> MetaDoc ann
metaDocWord = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocWord8 :: Word8 -> MetaDoc ann
metaDocWord8 :: forall ann. Word8 -> MetaDoc ann
metaDocWord8 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocWord16 :: Word16 -> MetaDoc ann
metaDocWord16 :: forall ann. Word16 -> MetaDoc ann
metaDocWord16 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocWord32 :: Word32 -> MetaDoc ann
metaDocWord32 :: forall ann. Word32 -> MetaDoc ann
metaDocWord32 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocWord64 :: Word64 -> MetaDoc ann
metaDocWord64 :: forall ann. Word64 -> MetaDoc ann
metaDocWord64 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocInt8 :: Int8 -> MetaDoc ann
metaDocInt8 :: forall ann. Int8 -> MetaDoc ann
metaDocInt8 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocInt16 :: Int16 -> MetaDoc ann
metaDocInt16 :: forall ann. Int16 -> MetaDoc ann
metaDocInt16 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocInt32 :: Int32 -> MetaDoc ann
metaDocInt32 :: forall ann. Int32 -> MetaDoc ann
metaDocInt32 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocInt64 :: Int64 -> MetaDoc ann
metaDocInt64 :: forall ann. Int64 -> MetaDoc ann
metaDocInt64 = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocUnit :: () -> MetaDoc ann
metaDocUnit :: forall ann. () -> MetaDoc ann
metaDocUnit = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocBool :: Bool -> MetaDoc ann
metaDocBool :: forall ann. Bool -> MetaDoc ann
metaDocBool = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
metaDocChar :: Char -> MetaDoc ann
metaDocChar :: forall ann. Char -> MetaDoc ann
metaDocChar = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
stringMetaDoc :: String -> MetaDoc ann
stringMetaDoc :: forall ann. String -> MetaDoc ann
stringMetaDoc String
str = forall ann. Doc ann -> MetaDoc ann
f forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty String
str
where
f :: Doc ann -> MetaDoc ann
f | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
' ') String
str = forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc
| Bool
otherwise = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc
strictTextMetaDoc :: T.Text -> MetaDoc ann
strictTextMetaDoc :: forall ann. Text -> MetaDoc ann
strictTextMetaDoc Text
str = forall ann. Doc ann -> MetaDoc ann
f forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Text
str
where
f :: Doc ann -> MetaDoc ann
f | (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
str = forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc
| Bool
otherwise = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc
lazyTextMetaDoc :: TL.Text -> MetaDoc ann
lazyTextMetaDoc :: forall ann. Text -> MetaDoc ann
lazyTextMetaDoc Text
str = forall ann. Doc ann -> MetaDoc ann
f forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Text
str
where
f :: Doc ann -> MetaDoc ann
f | (Char -> Bool) -> Text -> Bool
TL.any (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
str = forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc
| Bool
otherwise = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc
strictByteStringMetaDoc :: C8.ByteString -> MetaDoc ann
strictByteStringMetaDoc :: forall ann. ByteString -> MetaDoc ann
strictByteStringMetaDoc ByteString
str = forall ann. Doc ann -> MetaDoc ann
f forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack ByteString
str
where
f :: Doc ann -> MetaDoc ann
f | (Char -> Bool) -> ByteString -> Bool
C8.any (forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
str = forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc
| Bool
otherwise = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc
lazyByteStringMetaDoc :: CL8.ByteString -> MetaDoc ann
lazyByteStringMetaDoc :: forall ann. ByteString -> MetaDoc ann
lazyByteStringMetaDoc ByteString
str = forall ann. Doc ann -> MetaDoc ann
f forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ ByteString -> String
CL8.unpack ByteString
str
where
f :: Doc ann -> MetaDoc ann
f | (Char -> Bool) -> ByteString -> Bool
CL8.any (forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
str = forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc
| Bool
otherwise = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc
shortByteStringMetaDoc :: ShortBS.ShortByteString -> MetaDoc ann
shortByteStringMetaDoc :: forall ann. ShortByteString -> MetaDoc ann
shortByteStringMetaDoc ShortByteString
str = forall ann. Doc ann -> MetaDoc ann
f forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack ByteString
str'
where
str' :: ByteString
str' = ShortByteString -> ByteString
ShortBS.fromShort ShortByteString
str
f :: Doc ann -> MetaDoc ann
f | (Char -> Bool) -> ByteString -> Bool
C8.any (forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
str' = forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc
| Bool
otherwise = forall ann. Doc ann -> MetaDoc ann
atomicMetaDoc
constructorAppMetaDoc :: MetaDoc ann -> [MetaDoc ann] -> MetaDoc ann
constructorAppMetaDoc :: forall ann. MetaDoc ann -> [MetaDoc ann] -> MetaDoc ann
constructorAppMetaDoc MetaDoc ann
constructor [MetaDoc ann]
args =
case forall a b. (a -> b) -> [a] -> [b]
map forall ann. MetaDoc ann -> MetaDoc ann
field [MetaDoc ann]
args of
[] -> MetaDoc ann
constructor
[MetaDoc ann
f] -> forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc forall a b. (a -> b) -> a -> b
$ forall ann. MetaDoc ann -> Doc ann
mdPayload MetaDoc ann
constructor forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
group (forall ann. MetaDoc ann -> Doc ann
mdPayload MetaDoc ann
f)
[MetaDoc ann]
fs -> forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
PP.align forall a b. (a -> b) -> a -> b
$ forall ann. MetaDoc ann -> Doc ann
mdPayload MetaDoc ann
constructor forall ann. Doc ann -> Doc ann -> Doc ann
## forall ann. [Doc ann] -> Doc ann
PP.vsep (forall a b. (a -> b) -> [a] -> [b]
map forall ann. MetaDoc ann -> Doc ann
mdPayload [MetaDoc ann]
fs)
where
field :: MetaDoc ann -> MetaDoc ann
field :: forall ann. MetaDoc ann -> MetaDoc ann
field MetaDoc ann
md =
case forall ann. MetaDoc ann -> DocKind
mdKind MetaDoc ann
md of
DocKind
Atomic -> MetaDoc ann
md
DocKind
Composite -> forall ann. Doc ann -> MetaDoc ann
compositeMetaDoc forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann -> Doc ann
PP.flatAlt Doc ann
payload (forall ann. Doc ann -> Doc ann
PP.parens Doc ann
payload)
where
payload :: Doc ann
payload = forall ann. MetaDoc ann -> Doc ann
mdPayload MetaDoc ann
md