{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, ViewPatterns, DeriveFunctor, DeriveFoldable, DeriveTraversable, LambdaCase #-}
module Text.PrettyPrint.Compact.Core(Annotation,Layout(..),renderWith,Options(..),groupingBy,Doc,($$)) where

import Prelude ()
import Prelude.Compat as P

import Data.List.Compat (sortOn,groupBy,minimumBy)
import Data.Function (on)
import Data.Semigroup
import Data.Sequence (singleton, Seq, viewl, viewr, ViewL(..), ViewR(..), (|>))
import Data.String
import Data.Foldable (toList)
import Control.Applicative (liftA2)
-- | Annotated string, which consists of segments with separate (or no) annotations.
--
-- We keep annotated segments in a container (list).
-- The annotation is @Maybe a@, because the no-annotation case is common.
--
-- /Note:/ with @Last x@ annotation, the 'annotate' will overwrite all annotations.
--
-- /Note:/ if the list is changed into `Seq` or similar structure
-- allowing fast viewr and viewl, then we can impose an additional
-- invariant that there aren't two consequtive non-annotated segments;
-- yet there is no performance reason to do so.
--
data AS a = AS !Int [(a, String)]
  deriving (AS a -> AS a -> Bool
(AS a -> AS a -> Bool) -> (AS a -> AS a -> Bool) -> Eq (AS a)
forall a. Eq a => AS a -> AS a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AS a -> AS a -> Bool
== :: AS a -> AS a -> Bool
$c/= :: forall a. Eq a => AS a -> AS a -> Bool
/= :: AS a -> AS a -> Bool
Eq,Eq (AS a)
Eq (AS a) =>
(AS a -> AS a -> Ordering)
-> (AS a -> AS a -> Bool)
-> (AS a -> AS a -> Bool)
-> (AS a -> AS a -> Bool)
-> (AS a -> AS a -> Bool)
-> (AS a -> AS a -> AS a)
-> (AS a -> AS a -> AS a)
-> Ord (AS a)
AS a -> AS a -> Bool
AS a -> AS a -> Ordering
AS a -> AS a -> AS a
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
forall a. Ord a => Eq (AS a)
forall a. Ord a => AS a -> AS a -> Bool
forall a. Ord a => AS a -> AS a -> Ordering
forall a. Ord a => AS a -> AS a -> AS a
$ccompare :: forall a. Ord a => AS a -> AS a -> Ordering
compare :: AS a -> AS a -> Ordering
$c< :: forall a. Ord a => AS a -> AS a -> Bool
< :: AS a -> AS a -> Bool
$c<= :: forall a. Ord a => AS a -> AS a -> Bool
<= :: AS a -> AS a -> Bool
$c> :: forall a. Ord a => AS a -> AS a -> Bool
> :: AS a -> AS a -> Bool
$c>= :: forall a. Ord a => AS a -> AS a -> Bool
>= :: AS a -> AS a -> Bool
$cmax :: forall a. Ord a => AS a -> AS a -> AS a
max :: AS a -> AS a -> AS a
$cmin :: forall a. Ord a => AS a -> AS a -> AS a
min :: AS a -> AS a -> AS a
Ord,Int -> AS a -> ShowS
[AS a] -> ShowS
AS a -> String
(Int -> AS a -> ShowS)
-> (AS a -> String) -> ([AS a] -> ShowS) -> Show (AS a)
forall a. Show a => Int -> AS a -> ShowS
forall a. Show a => [AS a] -> ShowS
forall a. Show a => AS a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AS a -> ShowS
showsPrec :: Int -> AS a -> ShowS
$cshow :: forall a. Show a => AS a -> String
show :: AS a -> String
$cshowList :: forall a. Show a => [AS a] -> ShowS
showList :: [AS a] -> ShowS
Show,(forall a b. (a -> b) -> AS a -> AS b)
-> (forall a b. a -> AS b -> AS a) -> Functor AS
forall a b. a -> AS b -> AS a
forall a b. (a -> b) -> AS a -> AS b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AS a -> AS b
fmap :: forall a b. (a -> b) -> AS a -> AS b
$c<$ :: forall a b. a -> AS b -> AS a
<$ :: forall a b. a -> AS b -> AS a
Functor,(forall m. Monoid m => AS m -> m)
-> (forall m a. Monoid m => (a -> m) -> AS a -> m)
-> (forall m a. Monoid m => (a -> m) -> AS a -> m)
-> (forall a b. (a -> b -> b) -> b -> AS a -> b)
-> (forall a b. (a -> b -> b) -> b -> AS a -> b)
-> (forall b a. (b -> a -> b) -> b -> AS a -> b)
-> (forall b a. (b -> a -> b) -> b -> AS a -> b)
-> (forall a. (a -> a -> a) -> AS a -> a)
-> (forall a. (a -> a -> a) -> AS a -> a)
-> (forall a. AS a -> [a])
-> (forall a. AS a -> Bool)
-> (forall a. AS a -> Int)
-> (forall a. Eq a => a -> AS a -> Bool)
-> (forall a. Ord a => AS a -> a)
-> (forall a. Ord a => AS a -> a)
-> (forall a. Num a => AS a -> a)
-> (forall a. Num a => AS a -> a)
-> Foldable AS
forall a. Eq a => a -> AS a -> Bool
forall a. Num a => AS a -> a
forall a. Ord a => AS a -> a
forall m. Monoid m => AS m -> m
forall a. AS a -> Bool
forall a. AS a -> Int
forall a. AS a -> [a]
forall a. (a -> a -> a) -> AS a -> a
forall m a. Monoid m => (a -> m) -> AS a -> m
forall b a. (b -> a -> b) -> b -> AS a -> b
forall a b. (a -> b -> b) -> b -> AS a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => AS m -> m
fold :: forall m. Monoid m => AS m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AS a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AS a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AS a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> AS a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> AS a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AS a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AS a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AS a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AS a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AS a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AS a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> AS a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> AS a -> a
foldr1 :: forall a. (a -> a -> a) -> AS a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AS a -> a
foldl1 :: forall a. (a -> a -> a) -> AS a -> a
$ctoList :: forall a. AS a -> [a]
toList :: forall a. AS a -> [a]
$cnull :: forall a. AS a -> Bool
null :: forall a. AS a -> Bool
$clength :: forall a. AS a -> Int
length :: forall a. AS a -> Int
$celem :: forall a. Eq a => a -> AS a -> Bool
elem :: forall a. Eq a => a -> AS a -> Bool
$cmaximum :: forall a. Ord a => AS a -> a
maximum :: forall a. Ord a => AS a -> a
$cminimum :: forall a. Ord a => AS a -> a
minimum :: forall a. Ord a => AS a -> a
$csum :: forall a. Num a => AS a -> a
sum :: forall a. Num a => AS a -> a
$cproduct :: forall a. Num a => AS a -> a
product :: forall a. Num a => AS a -> a
Foldable,Functor AS
Foldable AS
(Functor AS, Foldable AS) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> AS a -> f (AS b))
-> (forall (f :: * -> *) a. Applicative f => AS (f a) -> f (AS a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AS a -> m (AS b))
-> (forall (m :: * -> *) a. Monad m => AS (m a) -> m (AS a))
-> Traversable AS
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => AS (m a) -> m (AS a)
forall (f :: * -> *) a. Applicative f => AS (f a) -> f (AS a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> AS a -> m (AS b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AS a -> f (AS b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AS a -> f (AS b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AS a -> f (AS b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => AS (f a) -> f (AS a)
sequenceA :: forall (f :: * -> *) a. Applicative f => AS (f a) -> f (AS a)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> AS a -> m (AS b)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> AS a -> m (AS b)
$csequence :: forall (m :: * -> *) a. Monad m => AS (m a) -> m (AS a)
sequence :: forall (m :: * -> *) a. Monad m => AS (m a) -> m (AS a)
Traversable)

-- | Tests the invariants of 'AS'
_validAs :: AS a -> Bool
_validAs :: forall a. AS a -> Bool
_validAs (AS Int
i [(a, String)]
s) = Bool
lengthInvariant Bool -> Bool -> Bool
&& Bool
noNewlineInvariant
  where
    lengthInvariant :: Bool
lengthInvariant = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((a, String) -> Int) -> [(a, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ((a, String) -> String) -> (a, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) [(a, String)]
s)
    noNewlineInvariant :: Bool
noNewlineInvariant = ((a, String) -> Bool) -> [(a, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
'\n' (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) [(a, String)]
s

asLength :: AS a -> Int
asLength :: forall a. AS a -> Int
asLength (AS Int
l [(a, String)]
_) = Int
l

-- | Make a non-annotated 'AS'.
mkAS :: Monoid a => String -> AS a
mkAS :: forall a. Monoid a => String -> AS a
mkAS String
s = Int -> [(a, String)] -> AS a
forall a. Int -> [(a, String)] -> AS a
AS (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) [(a
forall a. Monoid a => a
mempty, String
s)]

instance Semigroup (AS a) where
  AS Int
i [(a, String)]
xs <> :: AS a -> AS a -> AS a
<> AS Int
j [(a, String)]
ys = Int -> [(a, String)] -> AS a
forall a. Int -> [(a, String)] -> AS a
AS (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) ([(a, String)]
xs [(a, String)] -> [(a, String)] -> [(a, String)]
forall a. Semigroup a => a -> a -> a
<> [(a, String)]
ys)

newtype L a = L (Seq (AS a)) -- non-empty sequence
  deriving (L a -> L a -> Bool
(L a -> L a -> Bool) -> (L a -> L a -> Bool) -> Eq (L a)
forall a. Eq a => L a -> L a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => L a -> L a -> Bool
== :: L a -> L a -> Bool
$c/= :: forall a. Eq a => L a -> L a -> Bool
/= :: L a -> L a -> Bool
Eq,Eq (L a)
Eq (L a) =>
(L a -> L a -> Ordering)
-> (L a -> L a -> Bool)
-> (L a -> L a -> Bool)
-> (L a -> L a -> Bool)
-> (L a -> L a -> Bool)
-> (L a -> L a -> L a)
-> (L a -> L a -> L a)
-> Ord (L a)
L a -> L a -> Bool
L a -> L a -> Ordering
L a -> L a -> L a
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
forall a. Ord a => Eq (L a)
forall a. Ord a => L a -> L a -> Bool
forall a. Ord a => L a -> L a -> Ordering
forall a. Ord a => L a -> L a -> L a
$ccompare :: forall a. Ord a => L a -> L a -> Ordering
compare :: L a -> L a -> Ordering
$c< :: forall a. Ord a => L a -> L a -> Bool
< :: L a -> L a -> Bool
$c<= :: forall a. Ord a => L a -> L a -> Bool
<= :: L a -> L a -> Bool
$c> :: forall a. Ord a => L a -> L a -> Bool
> :: L a -> L a -> Bool
$c>= :: forall a. Ord a => L a -> L a -> Bool
>= :: L a -> L a -> Bool
$cmax :: forall a. Ord a => L a -> L a -> L a
max :: L a -> L a -> L a
$cmin :: forall a. Ord a => L a -> L a -> L a
min :: L a -> L a -> L a
Ord,Int -> L a -> ShowS
[L a] -> ShowS
L a -> String
(Int -> L a -> ShowS)
-> (L a -> String) -> ([L a] -> ShowS) -> Show (L a)
forall a. Show a => Int -> L a -> ShowS
forall a. Show a => [L a] -> ShowS
forall a. Show a => L a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> L a -> ShowS
showsPrec :: Int -> L a -> ShowS
$cshow :: forall a. Show a => L a -> String
show :: L a -> String
$cshowList :: forall a. Show a => [L a] -> ShowS
showList :: [L a] -> ShowS
Show,(forall a b. (a -> b) -> L a -> L b)
-> (forall a b. a -> L b -> L a) -> Functor L
forall a b. a -> L b -> L a
forall a b. (a -> b) -> L a -> L b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> L a -> L b
fmap :: forall a b. (a -> b) -> L a -> L b
$c<$ :: forall a b. a -> L b -> L a
<$ :: forall a b. a -> L b -> L a
Functor,(forall m. Monoid m => L m -> m)
-> (forall m a. Monoid m => (a -> m) -> L a -> m)
-> (forall m a. Monoid m => (a -> m) -> L a -> m)
-> (forall a b. (a -> b -> b) -> b -> L a -> b)
-> (forall a b. (a -> b -> b) -> b -> L a -> b)
-> (forall b a. (b -> a -> b) -> b -> L a -> b)
-> (forall b a. (b -> a -> b) -> b -> L a -> b)
-> (forall a. (a -> a -> a) -> L a -> a)
-> (forall a. (a -> a -> a) -> L a -> a)
-> (forall a. L a -> [a])
-> (forall a. L a -> Bool)
-> (forall a. L a -> Int)
-> (forall a. Eq a => a -> L a -> Bool)
-> (forall a. Ord a => L a -> a)
-> (forall a. Ord a => L a -> a)
-> (forall a. Num a => L a -> a)
-> (forall a. Num a => L a -> a)
-> Foldable L
forall a. Eq a => a -> L a -> Bool
forall a. Num a => L a -> a
forall a. Ord a => L a -> a
forall m. Monoid m => L m -> m
forall a. L a -> Bool
forall a. L a -> Int
forall a. L a -> [a]
forall a. (a -> a -> a) -> L a -> a
forall m a. Monoid m => (a -> m) -> L a -> m
forall b a. (b -> a -> b) -> b -> L a -> b
forall a b. (a -> b -> b) -> b -> L a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => L m -> m
fold :: forall m. Monoid m => L m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> L a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> L a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> L a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> L a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> L a -> b
foldr :: forall a b. (a -> b -> b) -> b -> L a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> L a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> L a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> L a -> b
foldl :: forall b a. (b -> a -> b) -> b -> L a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> L a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> L a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> L a -> a
foldr1 :: forall a. (a -> a -> a) -> L a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> L a -> a
foldl1 :: forall a. (a -> a -> a) -> L a -> a
$ctoList :: forall a. L a -> [a]
toList :: forall a. L a -> [a]
$cnull :: forall a. L a -> Bool
null :: forall a. L a -> Bool
$clength :: forall a. L a -> Int
length :: forall a. L a -> Int
$celem :: forall a. Eq a => a -> L a -> Bool
elem :: forall a. Eq a => a -> L a -> Bool
$cmaximum :: forall a. Ord a => L a -> a
maximum :: forall a. Ord a => L a -> a
$cminimum :: forall a. Ord a => L a -> a
minimum :: forall a. Ord a => L a -> a
$csum :: forall a. Num a => L a -> a
sum :: forall a. Num a => L a -> a
$cproduct :: forall a. Num a => L a -> a
product :: forall a. Num a => L a -> a
Foldable,Functor L
Foldable L
(Functor L, Foldable L) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> L a -> f (L b))
-> (forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> L a -> m (L b))
-> (forall (m :: * -> *) a. Monad m => L (m a) -> m (L a))
-> Traversable L
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> L a -> f (L b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
sequenceA :: forall (f :: * -> *) a. Applicative f => L (f a) -> f (L a)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> L a -> m (L b)
$csequence :: forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
sequence :: forall (m :: * -> *) a. Monad m => L (m a) -> m (L a)
Traversable)

instance Monoid a => Semigroup (L a) where
  L (Seq (AS a) -> ViewR (AS a)
forall a. Seq a -> ViewR a
viewr -> Seq (AS a)
xs :> AS a
x) <> :: L a -> L a -> L a
<> L (Seq (AS a) -> ViewL (AS a)
forall a. Seq a -> ViewL a
viewl -> AS a
y :< Seq (AS a)
ys) =
    Seq (AS a) -> L a
forall a. Seq (AS a) -> L a
L (Seq (AS a)
xs Seq (AS a) -> Seq (AS a) -> Seq (AS a)
forall a. Semigroup a => a -> a -> a
<> AS a -> Seq (AS a)
forall a. a -> Seq a
singleton (AS a
x AS a -> AS a -> AS a
forall a. Semigroup a => a -> a -> a
<> AS a
y) Seq (AS a) -> Seq (AS a) -> Seq (AS a)
forall a. Semigroup a => a -> a -> a
<> Seq (AS a) -> Seq (AS a)
indent Seq (AS a)
ys) where

    n :: Int
n      = AS a -> Int
forall a. AS a -> Int
asLength AS a
x
    pad :: AS a
pad    = String -> AS a
forall a. Monoid a => String -> AS a
mkAS (Int -> Char -> String
forall a. Int -> a -> [a]
P.replicate Int
n Char
' ')
    indent :: Seq (AS a) -> Seq (AS a)
indent = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Seq (AS a) -> Seq (AS a)
forall a. a -> a
id else (AS a -> AS a) -> Seq (AS a) -> Seq (AS a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AS a
pad AS a -> AS a -> AS a
forall a. Semigroup a => a -> a -> a
<>)

  L Seq (AS a)
_ <> L Seq (AS a)
_ = String -> L a
forall a. HasCallStack => String -> a
error String
"<> @L: invariant violated, Seq is empty"

instance Monoid a => Monoid (L a) where
   mempty :: L a
mempty = Seq (AS a) -> L a
forall a. Seq (AS a) -> L a
L (AS a -> Seq (AS a)
forall a. a -> Seq a
singleton (String -> AS a
forall a. Monoid a => String -> AS a
mkAS String
""))

instance Layout L where
   text :: forall a. Monoid a => String -> L a
text = Seq (AS a) -> L a
forall a. Seq (AS a) -> L a
L (Seq (AS a) -> L a) -> (String -> Seq (AS a)) -> String -> L a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AS a -> Seq (AS a)
forall a. a -> Seq a
singleton (AS a -> Seq (AS a)) -> (String -> AS a) -> String -> Seq (AS a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AS a
forall a. Monoid a => String -> AS a
mkAS
   flush :: forall a. Monoid a => L a -> L a
flush (L Seq (AS a)
xs) = Seq (AS a) -> L a
forall a. Seq (AS a) -> L a
L (Seq (AS a)
xs Seq (AS a) -> AS a -> Seq (AS a)
forall a. Seq a -> a -> Seq a
|> String -> AS a
forall a. Monoid a => String -> AS a
mkAS String
"")
   annotate :: forall a. Monoid a => a -> L a -> L a
annotate a
a (L Seq (AS a)
s') = Seq (AS a) -> L a
forall a. Seq (AS a) -> L a
L ((AS a -> AS a) -> Seq (AS a) -> Seq (AS a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AS a -> AS a
annotateAS Seq (AS a)
s')
      where annotateAS :: AS a -> AS a
annotateAS (AS Int
i [(a, String)]
s) = Int -> [(a, String)] -> AS a
forall a. Int -> [(a, String)] -> AS a
AS Int
i (((a, String) -> (a, String)) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, String) -> (a, String)
forall {b}. (a, b) -> (a, b)
annotatePart [(a, String)]
s)
            annotatePart :: (a, b) -> (a, b)
annotatePart (a
b, b
s) = (a
b a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
a, b
s)

renderWithL :: (Monoid a, Monoid r) => Options a r -> L a -> r
renderWithL :: forall a r. (Monoid a, Monoid r) => Options a r -> L a -> r
renderWithL Options a r
opts (L Seq (AS a)
xs) = [AS a] -> r
intercalate (Seq (AS a) -> [AS a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (AS a)
xs)
  where
    f :: a -> String -> r
f = Options a r -> a -> String -> r
forall a r. Options a r -> a -> String -> r
optsAnnotate Options a r
opts
    f' :: AS a -> r
f' (AS Int
_ [(a, String)]
s) = ((a, String) -> r) -> [(a, String)] -> r
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> String -> r) -> (a, String) -> r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> String -> r
f) [(a, String)]
s
    sep :: r
sep = a -> String -> r
f a
forall a. Monoid a => a
mempty String
"\n"

    intercalate :: [AS a] -> r
intercalate []     = r
forall a. Monoid a => a
mempty
    intercalate (AS a
y:[AS a]
ys) = AS a -> r
f' AS a
y r -> r -> r
forall a. Monoid a => a -> a -> a
`mappend` (AS a -> r) -> [AS a] -> r
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (r -> r -> r
forall a. Monoid a => a -> a -> a
mappend r
sep (r -> r) -> (AS a -> r) -> AS a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AS a -> r
f') [AS a]
ys

data Options a r = Options
    { forall a r. Options a r -> Int
optsPageWidth :: !Int              -- ^ maximum page width
    , forall a r. Options a r -> a -> String -> r
optsAnnotate  :: a -> String -> r  -- ^ how to annotate the string. /Note:/ the annotation should preserve the visible length of the string.
    }

class Layout d where
  text :: Monoid a => String -> d a
  flush :: Monoid a => d a -> d a
  -- | `<>` new annotation to the 'Doc'.
  --
  -- Example: 'Any True' annotation will transform the rendered 'Doc' into uppercase:
  --
  -- >>> let r = putStrLn . renderWith defaultOptions { optsAnnotate = \a x -> if a == Any True then map toUpper x else x }
  -- >>> r $ text "hello" <$$> annotate (Any True) (text "world")
  -- hello
  -- WORLD
  --
  annotate :: forall a. Monoid a => a -> d a -> d a

-- type parameter is phantom.
data M a = M {forall a. M a -> Int
height    :: Int,
              forall a. M a -> Int
lastWidth :: Int,
              forall a. M a -> Int
maxWidth  :: Int
              }
  deriving (Int -> M a -> ShowS
[M a] -> ShowS
M a -> String
(Int -> M a -> ShowS)
-> (M a -> String) -> ([M a] -> ShowS) -> Show (M a)
forall a. Int -> M a -> ShowS
forall a. [M a] -> ShowS
forall a. M a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> M a -> ShowS
showsPrec :: Int -> M a -> ShowS
$cshow :: forall a. M a -> String
show :: M a -> String
$cshowList :: forall a. [M a] -> ShowS
showList :: [M a] -> ShowS
Show,M a -> M a -> Bool
(M a -> M a -> Bool) -> (M a -> M a -> Bool) -> Eq (M a)
forall a. M a -> M a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. M a -> M a -> Bool
== :: M a -> M a -> Bool
$c/= :: forall a. M a -> M a -> Bool
/= :: M a -> M a -> Bool
Eq,Eq (M a)
Eq (M a) =>
(M a -> M a -> Ordering)
-> (M a -> M a -> Bool)
-> (M a -> M a -> Bool)
-> (M a -> M a -> Bool)
-> (M a -> M a -> Bool)
-> (M a -> M a -> M a)
-> (M a -> M a -> M a)
-> Ord (M a)
M a -> M a -> Bool
M a -> M a -> Ordering
M a -> M a -> M a
forall a. Eq (M a)
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
forall a. M a -> M a -> Bool
forall a. M a -> M a -> Ordering
forall a. M a -> M a -> M a
$ccompare :: forall a. M a -> M a -> Ordering
compare :: M a -> M a -> Ordering
$c< :: forall a. M a -> M a -> Bool
< :: M a -> M a -> Bool
$c<= :: forall a. M a -> M a -> Bool
<= :: M a -> M a -> Bool
$c> :: forall a. M a -> M a -> Bool
> :: M a -> M a -> Bool
$c>= :: forall a. M a -> M a -> Bool
>= :: M a -> M a -> Bool
$cmax :: forall a. M a -> M a -> M a
max :: M a -> M a -> M a
$cmin :: forall a. M a -> M a -> M a
min :: M a -> M a -> M a
Ord,(forall a b. (a -> b) -> M a -> M b)
-> (forall a b. a -> M b -> M a) -> Functor M
forall a b. a -> M b -> M a
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> M a -> M b
fmap :: forall a b. (a -> b) -> M a -> M b
$c<$ :: forall a b. a -> M b -> M a
<$ :: forall a b. a -> M b -> M a
Functor,(forall m. Monoid m => M m -> m)
-> (forall m a. Monoid m => (a -> m) -> M a -> m)
-> (forall m a. Monoid m => (a -> m) -> M a -> m)
-> (forall a b. (a -> b -> b) -> b -> M a -> b)
-> (forall a b. (a -> b -> b) -> b -> M a -> b)
-> (forall b a. (b -> a -> b) -> b -> M a -> b)
-> (forall b a. (b -> a -> b) -> b -> M a -> b)
-> (forall a. (a -> a -> a) -> M a -> a)
-> (forall a. (a -> a -> a) -> M a -> a)
-> (forall a. M a -> [a])
-> (forall a. M a -> Bool)
-> (forall a. M a -> Int)
-> (forall a. Eq a => a -> M a -> Bool)
-> (forall a. Ord a => M a -> a)
-> (forall a. Ord a => M a -> a)
-> (forall a. Num a => M a -> a)
-> (forall a. Num a => M a -> a)
-> Foldable M
forall a. Eq a => a -> M a -> Bool
forall a. Num a => M a -> a
forall a. Ord a => M a -> a
forall m. Monoid m => M m -> m
forall a. M a -> Bool
forall a. M a -> Int
forall a. M a -> [a]
forall a. (a -> a -> a) -> M a -> a
forall m a. Monoid m => (a -> m) -> M a -> m
forall b a. (b -> a -> b) -> b -> M a -> b
forall a b. (a -> b -> b) -> b -> M a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => M m -> m
fold :: forall m. Monoid m => M m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> M a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> M a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> M a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> M a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> M a -> b
foldr :: forall a b. (a -> b -> b) -> b -> M a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> M a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> M a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> M a -> b
foldl :: forall b a. (b -> a -> b) -> b -> M a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> M a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> M a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> M a -> a
foldr1 :: forall a. (a -> a -> a) -> M a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> M a -> a
foldl1 :: forall a. (a -> a -> a) -> M a -> a
$ctoList :: forall a. M a -> [a]
toList :: forall a. M a -> [a]
$cnull :: forall a. M a -> Bool
null :: forall a. M a -> Bool
$clength :: forall a. M a -> Int
length :: forall a. M a -> Int
$celem :: forall a. Eq a => a -> M a -> Bool
elem :: forall a. Eq a => a -> M a -> Bool
$cmaximum :: forall a. Ord a => M a -> a
maximum :: forall a. Ord a => M a -> a
$cminimum :: forall a. Ord a => M a -> a
minimum :: forall a. Ord a => M a -> a
$csum :: forall a. Num a => M a -> a
sum :: forall a. Num a => M a -> a
$cproduct :: forall a. Num a => M a -> a
product :: forall a. Num a => M a -> a
Foldable,Functor M
Foldable M
(Functor M, Foldable M) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> M a -> f (M b))
-> (forall (f :: * -> *) a. Applicative f => M (f a) -> f (M a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> M a -> m (M b))
-> (forall (m :: * -> *) a. Monad m => M (m a) -> m (M a))
-> Traversable M
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => M (m a) -> m (M a)
forall (f :: * -> *) a. Applicative f => M (f a) -> f (M a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> M a -> m (M b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> M a -> f (M b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> M a -> f (M b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> M a -> f (M b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => M (f a) -> f (M a)
sequenceA :: forall (f :: * -> *) a. Applicative f => M (f a) -> f (M a)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> M a -> m (M b)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> M a -> m (M b)
$csequence :: forall (m :: * -> *) a. Monad m => M (m a) -> m (M a)
sequence :: forall (m :: * -> *) a. Monad m => M (m a) -> m (M a)
Traversable)

instance Semigroup (M a) where
  M a
a <> :: M a -> M a -> M a
<> M a
b =
    M {maxWidth :: Int
maxWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (M a -> Int
forall a. M a -> Int
maxWidth M a
a) (M a -> Int
forall a. M a -> Int
maxWidth M a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ M a -> Int
forall a. M a -> Int
lastWidth M a
a),
       height :: Int
height = M a -> Int
forall a. M a -> Int
height M a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ M a -> Int
forall a. M a -> Int
height M a
b,
       lastWidth :: Int
lastWidth = M a -> Int
forall a. M a -> Int
lastWidth M a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ M a -> Int
forall a. M a -> Int
lastWidth M a
b}

instance Monoid a => Monoid (M a) where
  mempty :: M a
mempty = String -> M a
forall a. Monoid a => String -> M a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text String
""
  mappend :: M a -> M a -> M a
mappend = M a -> M a -> M a
forall a. Semigroup a => a -> a -> a
(<>)

instance Layout M where
  text :: forall a. Monoid a => String -> M a
text String
s = M {height :: Int
height = Int
0, maxWidth :: Int
maxWidth = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s, lastWidth :: Int
lastWidth = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s}
  flush :: forall a. Monoid a => M a -> M a
flush M a
a = M {maxWidth :: Int
maxWidth = M a -> Int
forall a. M a -> Int
maxWidth M a
a,
               height :: Int
height = M a -> Int
forall a. M a -> Int
height M a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
               lastWidth :: Int
lastWidth = Int
0}
  annotate :: forall a. Monoid a => a -> M a -> M a
annotate a
_ M{Int
height :: forall a. M a -> Int
lastWidth :: forall a. M a -> Int
maxWidth :: forall a. M a -> Int
height :: Int
lastWidth :: Int
maxWidth :: Int
..} = M{Int
height :: Int
lastWidth :: Int
maxWidth :: Int
height :: Int
lastWidth :: Int
maxWidth :: Int
..}
class Poset a where
  (≺) :: a -> a -> Bool


instance Poset (M a) where
  M Int
c1 Int
l1 Int
s1 ≺ :: M a -> M a -> Bool
≺ M Int
c2 Int
l2 Int
s2 = Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c2 Bool -> Bool -> Bool
&& Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l2 Bool -> Bool -> Bool
&& Int
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s2

mergeOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
mergeOn :: forall b a. Ord b => (a -> b) -> [a] -> [a] -> [a]
mergeOn a -> b
m = [a] -> [a] -> [a]
go
  where
    go :: [a] -> [a] -> [a]
go [] [a]
xs = [a]
xs
    go [a]
xs [] = [a]
xs
    go (a
x:[a]
xs) (a
y:[a]
ys)
      | a -> b
m a
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> b
m a
y  = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
go [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
      | Bool
otherwise    = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a] -> [a]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

mergeAllOn :: Ord b => (a -> b) -> [[a]] -> [a]
mergeAllOn :: forall b a. Ord b => (a -> b) -> [[a]] -> [a]
mergeAllOn a -> b
_ [] = []
mergeAllOn a -> b
m ([a]
x:[[a]]
xs) = (a -> b) -> [a] -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a] -> [a]
mergeOn a -> b
m [a]
x ((a -> b) -> [[a]] -> [a]
forall b a. Ord b => (a -> b) -> [[a]] -> [a]
mergeAllOn a -> b
m [[a]]
xs)

bestsOn :: forall a b. (Poset b, Ord b)
      => (a -> b) -- ^ measure
      -> [[a]] -> [a]
bestsOn :: forall a b. (Poset b, Ord b) => (a -> b) -> [[a]] -> [a]
bestsOn a -> b
m = (a -> b) -> [a] -> [a] -> [a]
forall b a. Poset b => (a -> b) -> [a] -> [a] -> [a]
paretoOn' a -> b
m [] ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [[a]] -> [a]
forall b a. Ord b => (a -> b) -> [[a]] -> [a]
mergeAllOn a -> b
m

-- | @paretoOn m = paretoOn' m []@
paretoOn' :: Poset b => (a -> b) -> [a] -> [a] -> [a]
paretoOn' :: forall b a. Poset b => (a -> b) -> [a] -> [a] -> [a]
paretoOn' a -> b
_ [a]
acc [] = [a] -> [a]
forall a. [a] -> [a]
P.reverse [a]
acc
paretoOn' a -> b
m [a]
acc (a
x:[a]
xs) = if (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((b -> b -> Bool
forall a. Poset a => a -> a -> Bool
≺ a -> b
m a
x) (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
m) [a]
acc
                            then (a -> b) -> [a] -> [a] -> [a]
forall b a. Poset b => (a -> b) -> [a] -> [a] -> [a]
paretoOn' a -> b
m [a]
acc [a]
xs
                            else (a -> b) -> [a] -> [a] -> [a]
forall b a. Poset b => (a -> b) -> [a] -> [a] -> [a]
paretoOn' a -> b
m (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) [a]
xs
                            -- because of the ordering, we have that
                            -- for all y ∈ acc, y <= x, and thus x ≺ y
                            -- is false. No need to refilter acc.

-- list sorted by lexicographic order for the first component
-- function argument is the page width
newtype ODoc a = MkDoc {forall a. ODoc a -> Int -> [Pair M L a]
fromDoc :: Int -> [(Pair M L a)]}
  deriving (forall a b. (a -> b) -> ODoc a -> ODoc b)
-> (forall a b. a -> ODoc b -> ODoc a) -> Functor ODoc
forall a b. a -> ODoc b -> ODoc a
forall a b. (a -> b) -> ODoc a -> ODoc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ODoc a -> ODoc b
fmap :: forall a b. (a -> b) -> ODoc a -> ODoc b
$c<$ :: forall a b. a -> ODoc b -> ODoc a
<$ :: forall a b. a -> ODoc b -> ODoc a
Functor

instance Monoid a => Semigroup (ODoc a) where
  MkDoc Int -> [Pair M L a]
xs <> :: ODoc a -> ODoc a -> ODoc a
<> MkDoc Int -> [Pair M L a]
ys = (Int -> [Pair M L a]) -> ODoc a
forall a. (Int -> [Pair M L a]) -> ODoc a
MkDoc ((Int -> [Pair M L a]) -> ODoc a)
-> (Int -> [Pair M L a]) -> ODoc a
forall a b. (a -> b) -> a -> b
$ \Int
w -> (Pair M L a -> M a) -> [[Pair M L a]] -> [Pair M L a]
forall a b. (Poset b, Ord b) => (a -> b) -> [[a]] -> [a]
bestsOn Pair M L a -> M a
forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> f a
frst [ Int -> [Pair M L a] -> [Pair M L a]
forall {g :: * -> *} {a}. Int -> [Pair M g a] -> [Pair M g a]
discardInvalid Int
w [Pair M L a
x Pair M L a -> Pair M L a -> Pair M L a
forall a. Semigroup a => a -> a -> a
<> Pair M L a
y | Pair M L a
y <- Int -> [Pair M L a]
ys Int
w] | Pair M L a
x <- Int -> [Pair M L a]
xs Int
w]

discardInvalid :: Int -> [Pair M g a] -> [Pair M g a]
discardInvalid Int
w = (Pair M g a -> Bool) -> [Pair M g a] -> [Pair M g a]
forall {g :: * -> *} {a}.
(Pair M g a -> Bool) -> [Pair M g a] -> [Pair M g a]
quasifilter (Int -> M a -> Bool
forall a. Int -> M a -> Bool
fits Int
w (M a -> Bool) -> (Pair M g a -> M a) -> Pair M g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair M g a -> M a
forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> f a
frst)

quasifilter :: (Pair M g a -> Bool) -> [Pair M g a] -> [Pair M g a]
quasifilter Pair M g a -> Bool
_ [] = []
quasifilter Pair M g a -> Bool
p [Pair M g a]
zs = let fzs :: [Pair M g a]
fzs = (Pair M g a -> Bool) -> [Pair M g a] -> [Pair M g a]
forall a. (a -> Bool) -> [a] -> [a]
filter Pair M g a -> Bool
p [Pair M g a]
zs
                   in if [Pair M g a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pair M g a]
fzs -- in case that there are no valid layouts, we take a narrow one.
                      then [(Pair M g a -> Pair M g a -> Ordering)
-> [Pair M g a] -> Pair M g a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Pair M g a -> Int) -> Pair M g a -> Pair M g a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (M a -> Int
forall a. M a -> Int
maxWidth (M a -> Int) -> (Pair M g a -> M a) -> Pair M g a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair M g a -> M a
forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> f a
frst)) [Pair M g a]
zs]
                      else [Pair M g a]
fzs

instance Monoid a => Monoid (ODoc a) where
  mempty :: ODoc a
mempty = String -> ODoc a
forall a. Monoid a => String -> ODoc a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text String
""
  mappend :: ODoc a -> ODoc a -> ODoc a
mappend = ODoc a -> ODoc a -> ODoc a
forall a. Semigroup a => a -> a -> a
(<>)

fits :: Int -> M a -> Bool
fits :: forall a. Int -> M a -> Bool
fits Int
w M a
x = M a -> Int
forall a. M a -> Int
maxWidth M a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w

instance Layout ODoc where
  text :: forall a. Monoid a => String -> ODoc a
text String
s = (Int -> [Pair M L a]) -> ODoc a
forall a. (Int -> [Pair M L a]) -> ODoc a
MkDoc ((Int -> [Pair M L a]) -> ODoc a)
-> (Int -> [Pair M L a]) -> ODoc a
forall a b. (a -> b) -> a -> b
$ \Int
_ -> [String -> Pair M L a
forall a. Monoid a => String -> Pair M L a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text String
s]
  flush :: forall a. Monoid a => ODoc a -> ODoc a
flush (MkDoc Int -> [Pair M L a]
xs) = (Int -> [Pair M L a]) -> ODoc a
forall a. (Int -> [Pair M L a]) -> ODoc a
MkDoc ((Int -> [Pair M L a]) -> ODoc a)
-> (Int -> [Pair M L a]) -> ODoc a
forall a b. (a -> b) -> a -> b
$ \Int
w -> (Pair M L a -> Pair M L a) -> [Pair M L a] -> [Pair M L a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair M L a -> Pair M L a
forall a. Monoid a => Pair M L a -> Pair M L a
forall (d :: * -> *) a. (Layout d, Monoid a) => d a -> d a
flush (Int -> [Pair M L a]
xs Int
w)
  annotate :: forall a. Monoid a => a -> ODoc a -> ODoc a
annotate a
a (MkDoc Int -> [Pair M L a]
xs) = (Int -> [Pair M L a]) -> ODoc a
forall a. (Int -> [Pair M L a]) -> ODoc a
MkDoc ((Int -> [Pair M L a]) -> ODoc a)
-> (Int -> [Pair M L a]) -> ODoc a
forall a b. (a -> b) -> a -> b
$ \Int
w -> (Pair M L a -> Pair M L a) -> [Pair M L a] -> [Pair M L a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Pair M L a -> Pair M L a
forall a. Monoid a => a -> Pair M L a -> Pair M L a
forall (d :: * -> *) a. (Layout d, Monoid a) => a -> d a -> d a
annotate a
a) (Int -> [Pair M L a]
xs Int
w)

renderWith :: (Monoid r, Annotation a)
           => Options a r  -- ^ rendering options
           -> ODoc a          -- ^ renderable
           -> r
renderWith :: forall r a. (Monoid r, Annotation a) => Options a r -> ODoc a -> r
renderWith Options a r
opts ODoc a
d = case [Pair M L a]
xs of
    [] -> String -> r
forall a. HasCallStack => String -> a
error String
"No suitable layout found."
    ((M a
_ :-: L a
x):[Pair M L a]
_) -> Options a r -> L a -> r
forall a r. (Monoid a, Monoid r) => Options a r -> L a -> r
renderWithL Options a r
opts L a
x
  where
    pageWidth :: Int
pageWidth = Options a r -> Int
forall a r. Options a r -> Int
optsPageWidth Options a r
opts
    xs :: [Pair M L a]
xs = Int -> [Pair M L a] -> [Pair M L a]
forall {g :: * -> *} {a}. Int -> [Pair M g a] -> [Pair M g a]
discardInvalid Int
pageWidth (ODoc a -> Int -> [Pair M L a]
forall a. ODoc a -> Int -> [Pair M L a]
fromDoc ODoc a
d Int
pageWidth)

onlySingleLine :: [Pair M L a] -> [Pair M L a]
onlySingleLine :: forall a. [Pair M L a] -> [Pair M L a]
onlySingleLine = (Pair M L a -> Bool) -> [Pair M L a] -> [Pair M L a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(M{Int
height :: forall a. M a -> Int
lastWidth :: forall a. M a -> Int
maxWidth :: forall a. M a -> Int
height :: Int
lastWidth :: Int
maxWidth :: Int
..} :-: L a
_) -> Int
height Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

spaces :: (Monoid a,Layout l) => Int -> l a
spaces :: forall a (l :: * -> *). (Monoid a, Layout l) => Int -> l a
spaces Int
n = String -> l a
forall a. Monoid a => String -> l a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text (String -> l a) -> String -> l a
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '


-- | The document @(x \$$> y)@ concatenates document @x@ and @y@ with
-- a linebreak in between. (infixr 5)
($$) :: (Layout d, Monoid a, Semigroup (d a)) => d a -> d a -> d a
d a
a $$ :: forall (d :: * -> *) a.
(Layout d, Monoid a, Semigroup (d a)) =>
d a -> d a -> d a
$$ d a
b = d a -> d a
forall a. Monoid a => d a -> d a
forall (d :: * -> *) a. (Layout d, Monoid a) => d a -> d a
flush d a
a d a -> d a -> d a
forall a. Semigroup a => a -> a -> a
<> d a
b

second :: (t -> b) -> (a, t) -> (a, b)
second t -> b
f (a
a,t
b) = (a
a, t -> b
f t
b)

groupingBy :: Monoid a => String -> [(Int,Doc a)] -> Doc a
groupingBy :: forall a. Monoid a => String -> [(Int, Doc a)] -> Doc a
groupingBy String
_ [] = Doc a
forall a. Monoid a => a
mempty
groupingBy String
separator [(Int, Doc a)]
ms = (Int -> [Pair M L a]) -> Doc a
forall a. (Int -> [Pair M L a]) -> ODoc a
MkDoc ((Int -> [Pair M L a]) -> Doc a) -> (Int -> [Pair M L a]) -> Doc a
forall a b. (a -> b) -> a -> b
$ \Int
w ->
  let mws :: [(Int, [Pair M L a])]
mws = ((Int, Doc a) -> (Int, [Pair M L a]))
-> [(Int, Doc a)] -> [(Int, [Pair M L a])]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc a -> [Pair M L a]) -> (Int, Doc a) -> (Int, [Pair M L a])
forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
second (((Int -> [Pair M L a]) -> Int -> [Pair M L a]
forall a b. (a -> b) -> a -> b
$ Int
w) ((Int -> [Pair M L a]) -> [Pair M L a])
-> (Doc a -> Int -> [Pair M L a]) -> Doc a -> [Pair M L a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Int -> [Pair M L a]
forall a. ODoc a -> Int -> [Pair M L a]
fromDoc)) [(Int, Doc a)]
ms
      (Int
_,[Pair M L a]
lastMw) = [(Int, [Pair M L a])] -> (Int, [Pair M L a])
forall a. HasCallStack => [a] -> a
last [(Int, [Pair M L a])]
mws
      hcatElems :: [[Pair M L a]]
hcatElems = ((Int, [Pair M L a]) -> [Pair M L a])
-> [(Int, [Pair M L a])] -> [[Pair M L a]]
forall a b. (a -> b) -> [a] -> [b]
map ([Pair M L a] -> [Pair M L a]
forall a. [Pair M L a] -> [Pair M L a]
onlySingleLine ([Pair M L a] -> [Pair M L a])
-> ((Int, [Pair M L a]) -> [Pair M L a])
-> (Int, [Pair M L a])
-> [Pair M L a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Pair M L a]) -> [Pair M L a]
forall a b. (a, b) -> b
snd) ([(Int, [Pair M L a])] -> [(Int, [Pair M L a])]
forall a. HasCallStack => [a] -> [a]
init [(Int, [Pair M L a])]
mws) [[Pair M L a]] -> [[Pair M L a]] -> [[Pair M L a]]
forall a. [a] -> [a] -> [a]
++ [[Pair M L a]
lastMw] -- all the elements except the first must fit on a single line
      vcatElems :: [[Pair M L a]]
vcatElems = ((Int, [Pair M L a]) -> [Pair M L a])
-> [(Int, [Pair M L a])] -> [[Pair M L a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
indent,[Pair M L a]
x) -> (Pair M L a -> Pair M L a) -> [Pair M L a] -> [Pair M L a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pair M L a
forall a (l :: * -> *). (Monoid a, Layout l) => Int -> l a
spaces Int
indent Pair M L a -> Pair M L a -> Pair M L a
forall a. Semigroup a => a -> a -> a
<>) [Pair M L a]
x) [(Int, [Pair M L a])]
mws
      horizontal :: [Pair M L a]
horizontal = Int -> [Pair M L a] -> [Pair M L a]
forall {g :: * -> *} {a}. Int -> [Pair M g a] -> [Pair M g a]
discardInvalid Int
w ([Pair M L a] -> [Pair M L a]) -> [Pair M L a] -> [Pair M L a]
forall a b. (a -> b) -> a -> b
$ ([Pair M L a] -> [Pair M L a] -> [Pair M L a])
-> [[Pair M L a]] -> [Pair M L a]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ((Pair M L a -> Pair M L a -> Pair M L a)
-> [Pair M L a] -> [Pair M L a] -> [Pair M L a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\Pair M L a
x Pair M L a
y -> Pair M L a
x Pair M L a -> Pair M L a -> Pair M L a
forall a. Semigroup a => a -> a -> a
<> String -> Pair M L a
forall a. Monoid a => String -> Pair M L a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text String
separator Pair M L a -> Pair M L a -> Pair M L a
forall a. Semigroup a => a -> a -> a
<> Pair M L a
y)) [[Pair M L a]]
hcatElems
      vertical :: [Pair M L a]
vertical = ([Pair M L a] -> [Pair M L a] -> [Pair M L a])
-> [[Pair M L a]] -> [Pair M L a]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\[Pair M L a]
xs [Pair M L a]
ys -> (Pair M L a -> M a) -> [[Pair M L a]] -> [Pair M L a]
forall a b. (Poset b, Ord b) => (a -> b) -> [[a]] -> [a]
bestsOn Pair M L a -> M a
forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> f a
frst [[Pair M L a
x Pair M L a -> Pair M L a -> Pair M L a
forall (d :: * -> *) a.
(Layout d, Monoid a, Semigroup (d a)) =>
d a -> d a -> d a
$$ Pair M L a
y | Pair M L a
y <- [Pair M L a]
ys] | Pair M L a
x <- [Pair M L a]
xs]) [[Pair M L a]]
vcatElems
  in (Pair M L a -> M a) -> [[Pair M L a]] -> [Pair M L a]
forall a b. (Poset b, Ord b) => (a -> b) -> [[a]] -> [a]
bestsOn Pair M L a -> M a
forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> f a
frst [[Pair M L a]
horizontal,[Pair M L a]
vertical]

data Pair f g a = (:-:) {forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> f a
frst :: f a, forall (f :: * -> *) (g :: * -> *) a. Pair f g a -> g a
scnd :: g a}
  deriving ((forall a b. (a -> b) -> Pair f g a -> Pair f g b)
-> (forall a b. a -> Pair f g b -> Pair f g a)
-> Functor (Pair f g)
forall a b. a -> Pair f g b -> Pair f g a
forall a b. (a -> b) -> Pair f g a -> Pair f g b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> Pair f g b -> Pair f g a
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> Pair f g a -> Pair f g b
$cfmap :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> Pair f g a -> Pair f g b
fmap :: forall a b. (a -> b) -> Pair f g a -> Pair f g b
$c<$ :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> Pair f g b -> Pair f g a
<$ :: forall a b. a -> Pair f g b -> Pair f g a
Functor,(forall m. Monoid m => Pair f g m -> m)
-> (forall m a. Monoid m => (a -> m) -> Pair f g a -> m)
-> (forall m a. Monoid m => (a -> m) -> Pair f g a -> m)
-> (forall a b. (a -> b -> b) -> b -> Pair f g a -> b)
-> (forall a b. (a -> b -> b) -> b -> Pair f g a -> b)
-> (forall b a. (b -> a -> b) -> b -> Pair f g a -> b)
-> (forall b a. (b -> a -> b) -> b -> Pair f g a -> b)
-> (forall a. (a -> a -> a) -> Pair f g a -> a)
-> (forall a. (a -> a -> a) -> Pair f g a -> a)
-> (forall a. Pair f g a -> [a])
-> (forall a. Pair f g a -> Bool)
-> (forall a. Pair f g a -> Int)
-> (forall a. Eq a => a -> Pair f g a -> Bool)
-> (forall a. Ord a => Pair f g a -> a)
-> (forall a. Ord a => Pair f g a -> a)
-> (forall a. Num a => Pair f g a -> a)
-> (forall a. Num a => Pair f g a -> a)
-> Foldable (Pair f g)
forall a. Eq a => a -> Pair f g a -> Bool
forall a. Num a => Pair f g a -> a
forall a. Ord a => Pair f g a -> a
forall m. Monoid m => Pair f g m -> m
forall a. Pair f g a -> Bool
forall a. Pair f g a -> Int
forall a. Pair f g a -> [a]
forall a. (a -> a -> a) -> Pair f g a -> a
forall m a. Monoid m => (a -> m) -> Pair f g a -> m
forall b a. (b -> a -> b) -> b -> Pair f g a -> b
forall a b. (a -> b -> b) -> b -> Pair f g a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Eq a) =>
a -> Pair f g a -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Num a) =>
Pair f g a -> a
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Ord a) =>
Pair f g a -> a
forall (f :: * -> *) (g :: * -> *) m.
(Foldable f, Foldable g, Monoid m) =>
Pair f g m -> m
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
Pair f g a -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
Pair f g a -> Int
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
Pair f g a -> [a]
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
(a -> a -> a) -> Pair f g a -> a
forall (f :: * -> *) (g :: * -> *) m a.
(Foldable f, Foldable g, Monoid m) =>
(a -> m) -> Pair f g a -> m
forall (f :: * -> *) (g :: * -> *) b a.
(Foldable f, Foldable g) =>
(b -> a -> b) -> b -> Pair f g a -> b
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
(a -> b -> b) -> b -> Pair f g a -> b
$cfold :: forall (f :: * -> *) (g :: * -> *) m.
(Foldable f, Foldable g, Monoid m) =>
Pair f g m -> m
fold :: forall m. Monoid m => Pair f g m -> m
$cfoldMap :: forall (f :: * -> *) (g :: * -> *) m a.
(Foldable f, Foldable g, Monoid m) =>
(a -> m) -> Pair f g a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Pair f g a -> m
$cfoldMap' :: forall (f :: * -> *) (g :: * -> *) m a.
(Foldable f, Foldable g, Monoid m) =>
(a -> m) -> Pair f g a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Pair f g a -> m
$cfoldr :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
(a -> b -> b) -> b -> Pair f g a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Pair f g a -> b
$cfoldr' :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
(a -> b -> b) -> b -> Pair f g a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Pair f g a -> b
$cfoldl :: forall (f :: * -> *) (g :: * -> *) b a.
(Foldable f, Foldable g) =>
(b -> a -> b) -> b -> Pair f g a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Pair f g a -> b
$cfoldl' :: forall (f :: * -> *) (g :: * -> *) b a.
(Foldable f, Foldable g) =>
(b -> a -> b) -> b -> Pair f g a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Pair f g a -> b
$cfoldr1 :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
(a -> a -> a) -> Pair f g a -> a
foldr1 :: forall a. (a -> a -> a) -> Pair f g a -> a
$cfoldl1 :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
(a -> a -> a) -> Pair f g a -> a
foldl1 :: forall a. (a -> a -> a) -> Pair f g a -> a
$ctoList :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
Pair f g a -> [a]
toList :: forall a. Pair f g a -> [a]
$cnull :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
Pair f g a -> Bool
null :: forall a. Pair f g a -> Bool
$clength :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
Pair f g a -> Int
length :: forall a. Pair f g a -> Int
$celem :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Eq a) =>
a -> Pair f g a -> Bool
elem :: forall a. Eq a => a -> Pair f g a -> Bool
$cmaximum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Ord a) =>
Pair f g a -> a
maximum :: forall a. Ord a => Pair f g a -> a
$cminimum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Ord a) =>
Pair f g a -> a
minimum :: forall a. Ord a => Pair f g a -> a
$csum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Num a) =>
Pair f g a -> a
sum :: forall a. Num a => Pair f g a -> a
$cproduct :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Num a) =>
Pair f g a -> a
product :: forall a. Num a => Pair f g a -> a
Foldable,Functor (Pair f g)
Foldable (Pair f g)
(Functor (Pair f g), Foldable (Pair f g)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Pair f g a -> f (Pair f g b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Pair f g (f a) -> f (Pair f g a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Pair f g a -> m (Pair f g b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Pair f g (m a) -> m (Pair f g a))
-> Traversable (Pair f g)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Pair f g (m a) -> m (Pair f g a)
forall (f :: * -> *) a.
Applicative f =>
Pair f g (f a) -> f (Pair f g a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pair f g a -> m (Pair f g b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pair f g a -> f (Pair f g b)
forall (f :: * -> *) (g :: * -> *).
(Traversable f, Traversable g) =>
Functor (Pair f g)
forall (f :: * -> *) (g :: * -> *).
(Traversable f, Traversable g) =>
Foldable (Pair f g)
forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Traversable f, Traversable g, Monad m) =>
Pair f g (m a) -> m (Pair f g a)
forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Traversable f, Traversable g, Applicative f) =>
Pair f g (f a) -> f (Pair f g a)
forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b.
(Traversable f, Traversable g, Monad m) =>
(a -> m b) -> Pair f g a -> m (Pair f g b)
forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b.
(Traversable f, Traversable g, Applicative f) =>
(a -> f b) -> Pair f g a -> f (Pair f g b)
$ctraverse :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b.
(Traversable f, Traversable g, Applicative f) =>
(a -> f b) -> Pair f g a -> f (Pair f g b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pair f g a -> f (Pair f g b)
$csequenceA :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Traversable f, Traversable g, Applicative f) =>
Pair f g (f a) -> f (Pair f g a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Pair f g (f a) -> f (Pair f g a)
$cmapM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b.
(Traversable f, Traversable g, Monad m) =>
(a -> m b) -> Pair f g a -> m (Pair f g b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Pair f g a -> m (Pair f g b)
$csequence :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Traversable f, Traversable g, Monad m) =>
Pair f g (m a) -> m (Pair f g a)
sequence :: forall (m :: * -> *) a. Monad m => Pair f g (m a) -> m (Pair f g a)
Traversable)

instance (Semigroup (f a), Semigroup (g a)) => Semigroup (Pair f g a) where
  (f a
x :-: g a
y) <> :: Pair f g a -> Pair f g a -> Pair f g a
<> (f a
x' :-: g a
y') = (f a
x f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
<> f a
x') f a -> g a -> Pair f g a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> Pair f g a
:-: (g a
y g a -> g a -> g a
forall a. Semigroup a => a -> a -> a
<> g a
y')
instance (Monoid (f a), Monoid (g a)) => Monoid (Pair f g a) where
  mempty :: Pair f g a
mempty = f a
forall a. Monoid a => a
mempty f a -> g a -> Pair f g a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> Pair f g a
:-: g a
forall a. Monoid a => a
mempty

instance (Layout a, Layout b) => Layout (Pair a b) where
  text :: forall a. Monoid a => String -> Pair a b a
text String
s = String -> a a
forall a. Monoid a => String -> a a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text String
s a a -> b a -> Pair a b a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> Pair f g a
:-: String -> b a
forall a. Monoid a => String -> b a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text String
s
  flush :: forall a. Monoid a => Pair a b a -> Pair a b a
flush (a a
a:-:b a
b) = (a a -> a a
forall a. Monoid a => a a -> a a
forall (d :: * -> *) a. (Layout d, Monoid a) => d a -> d a
flush a a
aa a -> b a -> Pair a b a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> Pair f g a
:-: b a -> b a
forall a. Monoid a => b a -> b a
forall (d :: * -> *) a. (Layout d, Monoid a) => d a -> d a
flush b a
b)
  annotate :: forall a. Monoid a => a -> Pair a b a -> Pair a b a
annotate a
x (a a
a:-:b a
b) = (a -> a a -> a a
forall a. Monoid a => a -> a a -> a a
forall (d :: * -> *) a. (Layout d, Monoid a) => a -> d a -> d a
annotate a
x a a
aa a -> b a -> Pair a b a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> Pair f g a
:-:a -> b a -> b a
forall a. Monoid a => a -> b a -> b a
forall (d :: * -> *) a. (Layout d, Monoid a) => a -> d a -> d a
annotate a
x b a
b)

instance Monoid a => IsString (Doc a) where
  fromString :: String -> Doc a
fromString = String -> Doc a
forall a. Monoid a => String -> ODoc a
forall (d :: * -> *) a. (Layout d, Monoid a) => String -> d a
text

type Annotation a = (Monoid a)
type Doc = ODoc

-- tt :: Doc ()
-- tt = groupingBy " " $ map (4,) $ 
--      ((replicate 4 $ groupingBy " " (map (4,) (map text ["fw"]))) ++
--       [groupingBy " " (map (0,) (map text ["fw","arstnwfyut","arstin","arstaruf"]))])

-- $setup
-- >>> import Text.PrettyPrint.Compact
-- >>> import Data.Monoid
-- >>> import Data.Char