{-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Calligraphy.Util.Printer where import Control.Monad.RWS import Control.Monad.State import Data.Foldable import Data.Text (Text) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as TB newtype Printer a = Printer {Printer a -> RWS Int () Builder a unPrinter :: RWS Int () Builder a} deriving newtype (a -> Printer b -> Printer a (a -> b) -> Printer a -> Printer b (forall a b. (a -> b) -> Printer a -> Printer b) -> (forall a b. a -> Printer b -> Printer a) -> Functor Printer forall a b. a -> Printer b -> Printer a forall a b. (a -> b) -> Printer a -> Printer b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> Printer b -> Printer a $c<$ :: forall a b. a -> Printer b -> Printer a fmap :: (a -> b) -> Printer a -> Printer b $cfmap :: forall a b. (a -> b) -> Printer a -> Printer b Functor, Functor Printer a -> Printer a Functor Printer -> (forall a. a -> Printer a) -> (forall a b. Printer (a -> b) -> Printer a -> Printer b) -> (forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c) -> (forall a b. Printer a -> Printer b -> Printer b) -> (forall a b. Printer a -> Printer b -> Printer a) -> Applicative Printer Printer a -> Printer b -> Printer b Printer a -> Printer b -> Printer a Printer (a -> b) -> Printer a -> Printer b (a -> b -> c) -> Printer a -> Printer b -> Printer c forall a. a -> Printer a forall a b. Printer a -> Printer b -> Printer a forall a b. Printer a -> Printer b -> Printer b forall a b. Printer (a -> b) -> Printer a -> Printer b forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f <* :: Printer a -> Printer b -> Printer a $c<* :: forall a b. Printer a -> Printer b -> Printer a *> :: Printer a -> Printer b -> Printer b $c*> :: forall a b. Printer a -> Printer b -> Printer b liftA2 :: (a -> b -> c) -> Printer a -> Printer b -> Printer c $cliftA2 :: forall a b c. (a -> b -> c) -> Printer a -> Printer b -> Printer c <*> :: Printer (a -> b) -> Printer a -> Printer b $c<*> :: forall a b. Printer (a -> b) -> Printer a -> Printer b pure :: a -> Printer a $cpure :: forall a. a -> Printer a $cp1Applicative :: Functor Printer Applicative, Applicative Printer a -> Printer a Applicative Printer -> (forall a b. Printer a -> (a -> Printer b) -> Printer b) -> (forall a b. Printer a -> Printer b -> Printer b) -> (forall a. a -> Printer a) -> Monad Printer Printer a -> (a -> Printer b) -> Printer b Printer a -> Printer b -> Printer b forall a. a -> Printer a forall a b. Printer a -> Printer b -> Printer b forall a b. Printer a -> (a -> Printer b) -> Printer b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: a -> Printer a $creturn :: forall a. a -> Printer a >> :: Printer a -> Printer b -> Printer b $c>> :: forall a b. Printer a -> Printer b -> Printer b >>= :: Printer a -> (a -> Printer b) -> Printer b $c>>= :: forall a b. Printer a -> (a -> Printer b) -> Printer b $cp1Monad :: Applicative Printer Monad) deriving (b -> Printer a -> Printer a NonEmpty (Printer a) -> Printer a Printer a -> Printer a -> Printer a (Printer a -> Printer a -> Printer a) -> (NonEmpty (Printer a) -> Printer a) -> (forall b. Integral b => b -> Printer a -> Printer a) -> Semigroup (Printer a) forall b. Integral b => b -> Printer a -> Printer a forall a. Semigroup a => NonEmpty (Printer a) -> Printer a forall a. Semigroup a => Printer a -> Printer a -> Printer a forall a b. (Semigroup a, Integral b) => b -> Printer a -> Printer a forall a. (a -> a -> a) -> (NonEmpty a -> a) -> (forall b. Integral b => b -> a -> a) -> Semigroup a stimes :: b -> Printer a -> Printer a $cstimes :: forall a b. (Semigroup a, Integral b) => b -> Printer a -> Printer a sconcat :: NonEmpty (Printer a) -> Printer a $csconcat :: forall a. Semigroup a => NonEmpty (Printer a) -> Printer a <> :: Printer a -> Printer a -> Printer a $c<> :: forall a. Semigroup a => Printer a -> Printer a -> Printer a Semigroup, Semigroup (Printer a) Printer a Semigroup (Printer a) -> Printer a -> (Printer a -> Printer a -> Printer a) -> ([Printer a] -> Printer a) -> Monoid (Printer a) [Printer a] -> Printer a Printer a -> Printer a -> Printer a forall a. Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a forall a. Monoid a => Semigroup (Printer a) forall a. Monoid a => Printer a forall a. Monoid a => [Printer a] -> Printer a forall a. Monoid a => Printer a -> Printer a -> Printer a mconcat :: [Printer a] -> Printer a $cmconcat :: forall a. Monoid a => [Printer a] -> Printer a mappend :: Printer a -> Printer a -> Printer a $cmappend :: forall a. Monoid a => Printer a -> Printer a -> Printer a mempty :: Printer a $cmempty :: forall a. Monoid a => Printer a $cp1Monoid :: forall a. Monoid a => Semigroup (Printer a) Monoid) via (Ap Printer a) type Prints a = a -> Printer () runPrinter :: Printer () -> Text runPrinter :: Printer () -> Text runPrinter (Printer RWS Int () Builder () p) = Text -> Text TL.toStrict (Text -> Text) -> ((Builder, ()) -> Text) -> (Builder, ()) -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Builder -> Text TB.toLazyText (Builder -> Text) -> ((Builder, ()) -> Builder) -> (Builder, ()) -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (Builder, ()) -> Builder forall a b. (a, b) -> a fst ((Builder, ()) -> Text) -> (Builder, ()) -> Text forall a b. (a -> b) -> a -> b $ RWS Int () Builder () -> Int -> Builder -> (Builder, ()) forall r w s a. RWS r w s a -> r -> s -> (s, w) execRWS RWS Int () Builder () p Int 0 Builder forall a. Monoid a => a mempty class Monad m => MonadPrint m where line :: Builder -> m () indent :: m a -> m a instance MonadPrint Printer where {-# INLINE indent #-} indent :: Printer a -> Printer a indent (Printer RWS Int () Builder a p) = RWS Int () Builder a -> Printer a forall a. RWS Int () Builder a -> Printer a Printer (RWS Int () Builder a -> Printer a) -> RWS Int () Builder a -> Printer a forall a b. (a -> b) -> a -> b $ (Int -> Int) -> RWS Int () Builder a -> RWS Int () Builder a forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (Int -> Int -> Int forall a. Num a => a -> a -> a + Int 4) RWS Int () Builder a p {-# INLINE line #-} line :: Builder -> Printer () line Builder t = RWS Int () Builder () -> Printer () forall a. RWS Int () Builder a -> Printer a Printer (RWS Int () Builder () -> Printer ()) -> RWS Int () Builder () -> Printer () forall a b. (a -> b) -> a -> b $ do Int n <- RWST Int () Builder Identity Int forall r (m :: * -> *). MonadReader r m => m r ask (Builder -> Builder) -> RWS Int () Builder () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((Builder -> Builder) -> RWS Int () Builder ()) -> (Builder -> Builder) -> RWS Int () Builder () forall a b. (a -> b) -> a -> b $ (Builder -> Builder -> Builder) -> Builder -> Builder -> Builder forall a b c. (a -> b -> c) -> b -> a -> c flip Builder -> Builder -> Builder forall a. Monoid a => a -> a -> a mappend (Builder -> Builder -> Builder) -> Builder -> Builder -> Builder forall a b. (a -> b) -> a -> b $ [Builder] -> Builder forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m fold (Int -> Builder -> [Builder] forall a. Int -> a -> [a] replicate Int n (Char -> Builder TB.singleton Char ' ')) Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder t Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Char -> Builder TB.singleton Char '\n' instance MonadPrint m => MonadPrint (StateT s m) where line :: Builder -> StateT s m () line = m () -> StateT s m () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m () -> StateT s m ()) -> (Builder -> m ()) -> Builder -> StateT s m () forall b c a. (b -> c) -> (a -> b) -> a -> c . Builder -> m () forall (m :: * -> *). MonadPrint m => Builder -> m () line indent :: StateT s m a -> StateT s m a indent (StateT s -> m (a, s) m) = (s -> m (a, s)) -> StateT s m a forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a StateT ((s -> m (a, s)) -> StateT s m a) -> (s -> m (a, s)) -> StateT s m a forall a b. (a -> b) -> a -> b $ m (a, s) -> m (a, s) forall (m :: * -> *) a. MonadPrint m => m a -> m a indent (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s) forall b c a. (b -> c) -> (a -> b) -> a -> c . s -> m (a, s) m {-# INLINE brack #-} brack :: MonadPrint m => String -> String -> m a -> m a brack :: String -> String -> m a -> m a brack String pre String post m a inner = String -> m () forall (m :: * -> *). MonadPrint m => String -> m () strLn String pre m () -> m a -> m a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> m a -> m a forall (m :: * -> *) a. MonadPrint m => m a -> m a indent m a inner m a -> m () -> m a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* String -> m () forall (m :: * -> *). MonadPrint m => String -> m () strLn String post {-# INLINE strLn #-} strLn :: MonadPrint m => String -> m () strLn :: String -> m () strLn = Builder -> m () forall (m :: * -> *). MonadPrint m => Builder -> m () line (Builder -> m ()) -> (String -> Builder) -> String -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Builder TB.fromString textLn :: MonadPrint m => Text -> m () textLn :: Text -> m () textLn = Builder -> m () forall (m :: * -> *). MonadPrint m => Builder -> m () line (Builder -> m ()) -> (Text -> Builder) -> Text -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Builder TB.fromText