{-# OPTIONS_GHC -fno-warn-orphans #-}
module Disco.Pretty.DSL where
import Control.Applicative hiding (empty)
import Data.String (IsString (..))
import Disco.Pretty.Prec
import Polysemy
import Polysemy.Reader
import Prettyprinter (Doc)
import qualified Prettyprinter as PP
import Prettyprinter.Internal (Doc (Empty))
import Prettyprinter.Render.String (renderString)
import Prelude hiding ((<>))
instance IsString (Sem r (Doc ann)) where
fromString :: String -> Sem r (Doc ann)
fromString = forall (m :: * -> *) ann. Applicative m => String -> m (Doc ann)
text
vcat :: Applicative f => [f (Doc ann)] -> f (Doc ann)
vcat :: forall (f :: * -> *) ann.
Applicative f =>
[f (Doc ann)] -> f (Doc ann)
vcat [f (Doc ann)]
ds = forall ann. [Doc ann] -> Doc ann
PP.vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [f (Doc ann)]
ds
hcat :: Applicative f => [f (Doc ann)] -> f (Doc ann)
hcat :: forall (f :: * -> *) ann.
Applicative f =>
[f (Doc ann)] -> f (Doc ann)
hcat [f (Doc ann)]
ds = forall ann. [Doc ann] -> Doc ann
PP.hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [f (Doc ann)]
ds
hsep :: Applicative f => [f (Doc ann)] -> f (Doc ann)
hsep :: forall (f :: * -> *) ann.
Applicative f =>
[f (Doc ann)] -> f (Doc ann)
hsep [f (Doc ann)]
ds = forall ann. [Doc ann] -> Doc ann
PP.hsep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [f (Doc ann)]
ds
parens :: Functor f => f (Doc ann) -> f (Doc ann)
parens :: forall (f :: * -> *) ann. Functor f => f (Doc ann) -> f (Doc ann)
parens = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
PP.parens
brackets :: Functor f => f (Doc ann) -> f (Doc ann)
brackets :: forall (f :: * -> *) ann. Functor f => f (Doc ann) -> f (Doc ann)
brackets = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
PP.brackets
braces :: Functor f => f (Doc ann) -> f (Doc ann)
braces :: forall (f :: * -> *) ann. Functor f => f (Doc ann) -> f (Doc ann)
braces = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
PP.braces
bag :: Applicative f => f (Doc ann) -> f (Doc ann)
bag :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann)
bag f (Doc ann)
p = forall (m :: * -> *) ann. Applicative m => String -> m (Doc ann)
text String
"⟅" forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann) -> f (Doc ann)
<> f (Doc ann)
p forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann) -> f (Doc ann)
<> forall (m :: * -> *) ann. Applicative m => String -> m (Doc ann)
text String
"⟆"
quotes :: Functor f => f (Doc ann) -> f (Doc ann)
quotes :: forall (f :: * -> *) ann. Functor f => f (Doc ann) -> f (Doc ann)
quotes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
PP.squotes
doubleQuotes :: Functor f => f (Doc ann) -> f (Doc ann)
doubleQuotes :: forall (f :: * -> *) ann. Functor f => f (Doc ann) -> f (Doc ann)
doubleQuotes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
PP.dquotes
text :: Applicative m => String -> m (Doc ann)
text :: forall (m :: * -> *) ann. Applicative m => String -> m (Doc ann)
text = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
integer :: Applicative m => Integer -> m (Doc ann)
integer :: forall (m :: * -> *) ann. Applicative m => Integer -> m (Doc ann)
integer = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
PP.pretty
nest :: Functor f => Int -> f (Doc ann) -> f (Doc ann)
nest :: forall (f :: * -> *) ann.
Functor f =>
Int -> f (Doc ann) -> f (Doc ann)
nest Int
n f (Doc ann)
d = forall ann. Int -> Doc ann -> Doc ann
PP.nest Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Doc ann)
d
indent :: Functor f => Int -> f (Doc ann) -> f (Doc ann)
indent :: forall (f :: * -> *) ann.
Functor f =>
Int -> f (Doc ann) -> f (Doc ann)
indent Int
n f (Doc ann)
d = forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Doc ann)
d
hang :: Applicative f => f (Doc ann) -> Int -> f (Doc ann) -> f (Doc ann)
hang :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> Int -> f (Doc ann) -> f (Doc ann)
hang f (Doc ann)
d1 Int
n f (Doc ann)
d2 = f (Doc ann)
d1 forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann) -> f (Doc ann)
<+> forall (f :: * -> *) ann.
Functor f =>
Int -> f (Doc ann) -> f (Doc ann)
nest Int
n f (Doc ann)
d2
empty :: Applicative m => m (Doc ann)
empty :: forall (m :: * -> *) ann. Applicative m => m (Doc ann)
empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall ann. Doc ann
PP.emptyDoc
(<+>) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
<+> :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann) -> f (Doc ann)
(<+>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall ann. Doc ann -> Doc ann -> Doc ann
(PP.<+>)
(<>) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
<> :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann) -> f (Doc ann)
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(PP.<>)
($+$) :: Applicative f => f (Doc ann) -> f (Doc ann) -> f (Doc ann)
f (Doc ann)
d1 $+$ :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> f (Doc ann) -> f (Doc ann)
$+$ f (Doc ann)
d2 = forall ann. Doc ann -> Doc ann -> Doc ann
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Doc ann)
d1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Doc ann)
d2
where
f :: Doc ann -> Doc ann -> Doc ann
f Doc ann
x1 Doc ann
Empty = Doc ann
x1
f Doc ann
x1 Doc ann
x2 = forall ann. [Doc ann] -> Doc ann
PP.vcat [Doc ann
x1, Doc ann
x2]
punctuate :: Applicative f => f (Doc ann) -> [f (Doc ann)] -> f [f (Doc ann)]
punctuate :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> [f (Doc ann)] -> f [f (Doc ann)]
punctuate f (Doc ann)
p [f (Doc ann)]
ds = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
PP.punctuate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Doc ann)
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [f (Doc ann)]
ds)
intercalate :: Monad f => f (Doc ann) -> [f (Doc ann)] -> f (Doc ann)
intercalate :: forall (f :: * -> *) ann.
Monad f =>
f (Doc ann) -> [f (Doc ann)] -> f (Doc ann)
intercalate f (Doc ann)
p [f (Doc ann)]
ds = do
[f (Doc ann)]
ds' <- forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> [f (Doc ann)] -> f [f (Doc ann)]
punctuate f (Doc ann)
p [f (Doc ann)]
ds
forall (f :: * -> *) ann.
Applicative f =>
[f (Doc ann)] -> f (Doc ann)
hsep [f (Doc ann)]
ds'
bulletList :: Applicative f => f (Doc ann) -> [f (Doc ann)] -> f (Doc ann)
bulletList :: forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> [f (Doc ann)] -> f (Doc ann)
bulletList f (Doc ann)
bullet = forall (f :: * -> *) ann.
Applicative f =>
[f (Doc ann)] -> f (Doc ann)
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) ann.
Applicative f =>
f (Doc ann) -> Int -> f (Doc ann) -> f (Doc ann)
hang f (Doc ann)
bullet Int
2)
renderDoc :: Sem (Reader PA ': r) (Doc ann) -> Sem r String
renderDoc :: forall (r :: EffectRow) ann.
Sem (Reader PA : r) (Doc ann) -> Sem r String
renderDoc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> String
renderDoc' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader PA
initPA
renderDoc' :: Doc ann -> String
renderDoc' :: forall ann. Doc ann -> String
renderDoc' = forall ann. SimpleDocStream ann -> String
renderString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PP.layoutPretty LayoutOptions
PP.defaultLayoutOptions