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