{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-unticked-promoted-constructors #-}

module Constrained.PrettyUtils where

import Constrained.List
import Data.String (fromString)
import Data.Typeable
import Prettyprinter

-- ===================================================================
-- Pretty Printer Helper functions
-- ===================================================================

data WithPrec a = WithPrec Int a

parensIf :: Bool -> Doc ann -> Doc ann
parensIf :: forall ann. Bool -> Doc ann -> Doc ann
parensIf Bool
True = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens
parensIf Bool
False = Doc ann -> Doc ann
forall a. a -> a
id

prettyPrec :: Pretty (WithPrec a) => Int -> a -> Doc ann
prettyPrec :: forall a ann. Pretty (WithPrec a) => Int -> a -> Doc ann
prettyPrec Int
p = WithPrec a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. WithPrec a -> Doc ann
pretty (WithPrec a -> Doc ann) -> (a -> WithPrec a) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> WithPrec a
forall a. Int -> a -> WithPrec a
WithPrec Int
p

ppList_ :: forall f as ann. (forall a. f a -> Doc ann) -> List f as -> [Doc ann]
ppList_ :: forall {k} (f :: k -> *) (as :: [k]) ann.
(forall (a :: k). f a -> Doc ann) -> List f as -> [Doc ann]
ppList_ forall (a :: k). f a -> Doc ann
_ List f as
Nil = []
ppList_ forall (a :: k). f a -> Doc ann
pp (f a
a :> List f as1
as) = f a -> Doc ann
forall (a :: k). f a -> Doc ann
pp f a
a Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (forall (a :: k). f a -> Doc ann) -> List f as1 -> [Doc ann]
forall {k} (f :: k -> *) (as :: [k]) ann.
(forall (a :: k). f a -> Doc ann) -> List f as -> [Doc ann]
ppList_ f a -> Doc ann
forall (a :: k). f a -> Doc ann
pp List f as1
as

ppListShow ::
  forall f as ann. All Show as => (forall a. Show a => f a -> Doc ann) -> List f as -> [Doc ann]
ppListShow :: forall (f :: * -> *) (as :: [*]) ann.
All Show as =>
(forall a. Show a => f a -> Doc ann) -> List f as -> [Doc ann]
ppListShow forall a. Show a => f a -> Doc ann
_ List f as
Nil = []
ppListShow forall a. Show a => f a -> Doc ann
pp (f a
a :> List f as1
as) = f a -> Doc ann
forall a. Show a => f a -> Doc ann
pp f a
a Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (forall a. Show a => f a -> Doc ann) -> List f as1 -> [Doc ann]
forall (f :: * -> *) (as :: [*]) ann.
All Show as =>
(forall a. Show a => f a -> Doc ann) -> List f as -> [Doc ann]
ppListShow f a -> Doc ann
forall a. Show a => f a -> Doc ann
pp List f as1
as

prettyType :: forall t x. Typeable t => Doc x
prettyType :: forall {k} (t :: k) x. Typeable t => Doc x
prettyType = String -> Doc x
forall a. IsString a => String -> a
fromString (String -> Doc x) -> String -> Doc x
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))

vsep' :: [Doc ann] -> Doc ann
vsep' :: forall ann. [Doc ann] -> Doc ann
vsep' = 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 a. Monoid a => [a] -> a
mconcat ([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]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
hardline

(/>) :: Doc ann -> Doc ann -> Doc ann
Doc ann
h /> :: forall ann. Doc ann -> Doc ann -> Doc ann
/> Doc ann
cont = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (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
sep [Doc ann
h, Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
cont]

infixl 5 />

showType :: forall t. Typeable t => String
showType :: forall {k} (t :: k). Typeable t => String
showType = TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))

short :: forall a x. (Show a, Typeable a) => [a] -> Doc x
short :: forall a x. (Show a, Typeable a) => [a] -> Doc x
short [] = Doc x
"[]"
short [a
x] =
  let raw :: String
raw = a -> String
forall a. Show a => a -> String
show a
x
      refined :: String
refined = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
raw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20 then String
raw else Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
20 String
raw String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ... "
   in Doc x
"[" Doc x -> Doc x -> Doc x
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc x
forall a. IsString a => String -> a
fromString String
refined Doc x -> Doc x -> Doc x
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc x
"]"
short [a]
xs =
  let raw :: String
raw = [a] -> String
forall a. Show a => a -> String
show [a]
xs
   in if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
raw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
50
        then String -> Doc x
forall a. IsString a => String -> a
fromString String
raw
        else Doc x
"([" Doc x -> Doc x -> Doc x
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc x
forall a ann. Show a => a -> Doc ann
viaShow ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Doc x -> Doc x -> Doc x
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc x
"elements ...] @" Doc x -> Doc x -> Doc x
forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k) x. Typeable t => Doc x
forall t x. Typeable t => Doc x
prettyType @a Doc x -> Doc x -> Doc x
forall a. Semigroup a => a -> a -> a
<> Doc x
")"