{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Haskell parallel to @unison/base.Doc@.
--
--   These types have two significant parameters: @ident@ and @code@ that are expected to be parameterized by some
--   representation of identifiers and source code of the host language.
--
--   This is much more restricted than @unison/base.Doc@, but it covers everything we can parse from Haskell. The
--   mismatch with Unison is a problem, as someone can create a Unison Doc with explicit constructors or function calls,
--   have it rendered to a scratch file, and then we can’t parse it. Changing the types here to match Unison wouldn’t
--   fix the issue. We have to modify the types and parser in concert (in both Haskell and Unison) to bring them in
--   line.
module Unison.Syntax.Parser.Doc.Data where

import Data.Bifoldable (Bifoldable, bifoldr)
import Data.Bitraversable (Bitraversable, bitraverse)
import Data.Eq.Deriving (deriveEq1, deriveEq2)
import Data.Functor.Classes (Eq1 (..), Ord1 (..), Show1 (..))
import Data.List.NonEmpty (NonEmpty)
import Data.Ord.Deriving (deriveOrd1, deriveOrd2)
import Text.Show.Deriving (deriveShow1, deriveShow2)
import Unison.Prelude hiding (Word)
import Prelude hiding (Word)

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

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

$(deriveEq1 ''Paragraph)
$(deriveOrd1 ''Paragraph)
$(deriveShow1 ''Paragraph)

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

instance Eq1 List where
  liftEq :: forall a b. (a -> b -> Bool) -> List a -> List b -> Bool
liftEq a -> b -> Bool
eqA = ((List a, List b) -> Bool) -> List a -> List b -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
    (BulletedList NonEmpty (Column a)
as, BulletedList NonEmpty (Column b)
as') -> (Column a -> Column b -> Bool)
-> NonEmpty (Column a) -> NonEmpty (Column b) -> Bool
forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> Column a -> Column b -> Bool
forall a b. (a -> b -> Bool) -> Column a -> Column b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eqA) NonEmpty (Column a)
as NonEmpty (Column b)
as'
    (NumberedList NonEmpty (Word64, Column a)
as, NumberedList NonEmpty (Word64, Column b)
as') -> ((Word64, Column a) -> (Word64, Column b) -> Bool)
-> NonEmpty (Word64, Column a)
-> NonEmpty (Word64, Column b)
-> Bool
forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((Column a -> Column b -> Bool)
-> (Word64, Column a) -> (Word64, Column b) -> Bool
forall a b. (a -> b -> Bool) -> (Word64, a) -> (Word64, b) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> Column a -> Column b -> Bool
forall a b. (a -> b -> Bool) -> Column a -> Column b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eqA)) NonEmpty (Word64, Column a)
as NonEmpty (Word64, Column b)
as'
    (List a
_, List b
_) -> Bool
False

instance Ord1 List where
  liftCompare :: forall a b. (a -> b -> Ordering) -> List a -> List b -> Ordering
liftCompare a -> b -> Ordering
compareA = ((List a, List b) -> Ordering) -> List a -> List b -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
    (BulletedList NonEmpty (Column a)
as, BulletedList NonEmpty (Column b)
as') -> (Column a -> Column b -> Ordering)
-> NonEmpty (Column a) -> NonEmpty (Column b) -> Ordering
forall a b.
(a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> Column a -> Column b -> Ordering
forall a b.
(a -> b -> Ordering) -> Column a -> Column b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
compareA) NonEmpty (Column a)
as NonEmpty (Column b)
as'
    (NumberedList NonEmpty (Word64, Column a)
as, NumberedList NonEmpty (Word64, Column b)
as') -> ((Word64, Column a) -> (Word64, Column b) -> Ordering)
-> NonEmpty (Word64, Column a)
-> NonEmpty (Word64, Column b)
-> Ordering
forall a b.
(a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((Column a -> Column b -> Ordering)
-> (Word64, Column a) -> (Word64, Column b) -> Ordering
forall a b.
(a -> b -> Ordering) -> (Word64, a) -> (Word64, b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> Column a -> Column b -> Ordering
forall a b.
(a -> b -> Ordering) -> Column a -> Column b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
compareA)) NonEmpty (Word64, Column a)
as NonEmpty (Word64, Column b)
as'
    (BulletedList NonEmpty (Column a)
_, NumberedList NonEmpty (Word64, Column b)
_) -> Ordering
LT
    (NumberedList NonEmpty (Word64, Column a)
_, BulletedList NonEmpty (Column b)
_) -> Ordering
GT

instance Show1 List where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> List a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA Int
prec =
    Bool -> ShowS -> ShowS
showParen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
11) (ShowS -> ShowS) -> (List a -> ShowS) -> List a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      BulletedList NonEmpty (Column a)
as ->
        String -> ShowS
showString String
"BulletedList "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Column a -> ShowS)
-> ([Column a] -> ShowS) -> Int -> NonEmpty (Column a) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [Column a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Column a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA) Int
11 NonEmpty (Column a)
as
      NumberedList NonEmpty (Word64, Column a)
as ->
        String -> ShowS
showString String
"NumberedList "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Word64, Column a) -> ShowS)
-> ([(Word64, Column a)] -> ShowS)
-> Int
-> NonEmpty (Word64, Column a)
-> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec
            ((Int -> Column a -> ShowS)
-> ([Column a] -> ShowS) -> Int -> (Word64, Column a) -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> (Word64, a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [Column a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Column a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA))
            ((Int -> Column a -> ShowS)
-> ([Column a] -> ShowS) -> [(Word64, Column a)] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [(Word64, a)] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [Column a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Column a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA))
            Int
11
            NonEmpty (Word64, Column a)
as

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

instance Eq1 Column where
  liftEq :: forall a b. (a -> b -> Bool) -> Column a -> Column b -> Bool
liftEq a -> b -> Bool
eqA (Column Paragraph a
para Maybe (List a)
mlist) (Column Paragraph b
para' Maybe (List b)
mlist') =
    (a -> b -> Bool) -> Paragraph a -> Paragraph b -> Bool
forall a b. (a -> b -> Bool) -> Paragraph a -> Paragraph b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eqA Paragraph a
para Paragraph b
para' Bool -> Bool -> Bool
&& (List a -> List b -> Bool)
-> Maybe (List a) -> Maybe (List b) -> Bool
forall a b. (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> List a -> List b -> Bool
forall a b. (a -> b -> Bool) -> List a -> List b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eqA) Maybe (List a)
mlist Maybe (List b)
mlist'

instance Ord1 Column where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Column a -> Column b -> Ordering
liftCompare a -> b -> Ordering
compareA (Column Paragraph a
para Maybe (List a)
mlist) (Column Paragraph b
para' Maybe (List b)
mlist') =
    (a -> b -> Ordering) -> Paragraph a -> Paragraph b -> Ordering
forall a b.
(a -> b -> Ordering) -> Paragraph a -> Paragraph b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
compareA Paragraph a
para Paragraph b
para' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (List a -> List b -> Ordering)
-> Maybe (List a) -> Maybe (List b) -> Ordering
forall a b. (a -> b -> Ordering) -> Maybe a -> Maybe b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> List a -> List b -> Ordering
forall a b. (a -> b -> Ordering) -> List a -> List b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
compareA) Maybe (List a)
mlist Maybe (List b)
mlist'

instance Show1 Column where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Column a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA Int
prec (Column Paragraph a
para Maybe (List a)
mlist) =
    Bool -> ShowS -> ShowS
showParen (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"Column "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Paragraph a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Paragraph a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA Int
11 Paragraph a
para
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> List a -> ShowS)
-> ([List a] -> ShowS) -> Int -> Maybe (List a) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Maybe a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> List a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> List a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [List a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [List a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
showsPrecA [a] -> ShowS
showListA) Int
11 Maybe (List a)
mlist

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

instance Bifoldable (Top code) where
  bifoldr :: forall a c b.
(a -> c -> c) -> (b -> c -> c) -> c -> Top code a b -> c
bifoldr a -> c -> c
f b -> c -> c
g c
z = \case
    Section Paragraph a
para [b]
as -> (a -> c -> c) -> c -> Paragraph a -> c
forall a b. (a -> b -> b) -> b -> Paragraph a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> c -> c
f ((b -> c -> c) -> c -> [b] -> c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> c -> c
g c
z [b]
as) Paragraph a
para
    Eval code
_ -> c
z
    ExampleBlock code
_ -> c
z
    CodeBlock String
_ String
_ -> c
z
    List' List a
list -> (a -> c -> c) -> c -> List a -> c
forall a b. (a -> b -> b) -> b -> List a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> c -> c
f c
z List a
list
    Paragraph' Paragraph a
para -> (a -> c -> c) -> c -> Paragraph a -> c
forall a b. (a -> b -> b) -> b -> Paragraph a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> c -> c
f c
z Paragraph a
para

instance Bifunctor (Top code) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Top code a c -> Top code b d
bimap a -> b
f c -> d
g = \case
    Section Paragraph a
para [c]
as -> Paragraph b -> [d] -> Top code b d
forall code leaf a. Paragraph leaf -> [a] -> Top code leaf a
Section ((a -> b) -> Paragraph a -> Paragraph b
forall a b. (a -> b) -> Paragraph a -> Paragraph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Paragraph a
para) ([d] -> Top code b d) -> [d] -> Top code b d
forall a b. (a -> b) -> a -> b
$ (c -> d) -> [c] -> [d]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g [c]
as
    Eval code
code -> code -> Top code b d
forall code leaf a. code -> Top code leaf a
Eval code
code
    ExampleBlock code
code -> code -> Top code b d
forall code leaf a. code -> Top code leaf a
ExampleBlock code
code
    CodeBlock String
title String
body -> String -> String -> Top code b d
forall code leaf a. String -> String -> Top code leaf a
CodeBlock String
title String
body
    List' List a
list -> List b -> Top code b d
forall code leaf a. List leaf -> Top code leaf a
List' (List b -> Top code b d) -> List b -> Top code b d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> List a -> List b
forall a b. (a -> b) -> List a -> List b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f List a
list
    Paragraph' Paragraph a
para -> Paragraph b -> Top code b d
forall code leaf a. Paragraph leaf -> Top code leaf a
Paragraph' (Paragraph b -> Top code b d) -> Paragraph b -> Top code b d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Paragraph a -> Paragraph b
forall a b. (a -> b) -> Paragraph a -> Paragraph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Paragraph a
para

instance Bitraversable (Top code) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Top code a b -> f (Top code c d)
bitraverse a -> f c
f b -> f d
g = \case
    Section Paragraph a
para [b]
as -> Paragraph c -> [d] -> Top code c d
forall code leaf a. Paragraph leaf -> [a] -> Top code leaf a
Section (Paragraph c -> [d] -> Top code c d)
-> f (Paragraph c) -> f ([d] -> Top code c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> Paragraph a -> f (Paragraph c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Paragraph a -> f (Paragraph b)
traverse a -> f c
f Paragraph a
para f ([d] -> Top code c d) -> f [d] -> f (Top code c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f d) -> [b] -> f [d]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse b -> f d
g [b]
as
    Eval code
code -> Top code c d -> f (Top code c d)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Top code c d -> f (Top code c d))
-> Top code c d -> f (Top code c d)
forall a b. (a -> b) -> a -> b
$ code -> Top code c d
forall code leaf a. code -> Top code leaf a
Eval code
code
    ExampleBlock code
code -> Top code c d -> f (Top code c d)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Top code c d -> f (Top code c d))
-> Top code c d -> f (Top code c d)
forall a b. (a -> b) -> a -> b
$ code -> Top code c d
forall code leaf a. code -> Top code leaf a
ExampleBlock code
code
    CodeBlock String
title String
body -> Top code c d -> f (Top code c d)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Top code c d -> f (Top code c d))
-> Top code c d -> f (Top code c d)
forall a b. (a -> b) -> a -> b
$ String -> String -> Top code c d
forall code leaf a. String -> String -> Top code leaf a
CodeBlock String
title String
body
    List' List a
list -> List c -> Top code c d
forall code leaf a. List leaf -> Top code leaf a
List' (List c -> Top code c d) -> f (List c) -> f (Top code c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> List a -> f (List c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List b)
traverse a -> f c
f List a
list
    Paragraph' Paragraph a
para -> Paragraph c -> Top code c d
forall code leaf a. Paragraph leaf -> Top code leaf a
Paragraph' (Paragraph c -> Top code c d)
-> f (Paragraph c) -> f (Top code c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> Paragraph a -> f (Paragraph c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Paragraph a -> f (Paragraph b)
traverse a -> f c
f Paragraph a
para

$(deriveEq1 ''Top)
$(deriveOrd1 ''Top)
$(deriveShow1 ''Top)
$(deriveEq2 ''Top)
$(deriveOrd2 ''Top)
$(deriveShow2 ''Top)

-- | This is a deviation from the Unison Doc data model – in Unison, Doc distinguishes between type and term links, but
--   here Doc knows nothing about what namespaces may exist.
data EmbedLink a = EmbedLink a
  deriving (EmbedLink a -> EmbedLink a -> Bool
(EmbedLink a -> EmbedLink a -> Bool)
-> (EmbedLink a -> EmbedLink a -> Bool) -> Eq (EmbedLink a)
forall a. Eq a => EmbedLink a -> EmbedLink a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => EmbedLink a -> EmbedLink a -> Bool
== :: EmbedLink a -> EmbedLink a -> Bool
$c/= :: forall a. Eq a => EmbedLink a -> EmbedLink a -> Bool
/= :: EmbedLink a -> EmbedLink a -> Bool
Eq, Eq (EmbedLink a)
Eq (EmbedLink a) =>
(EmbedLink a -> EmbedLink a -> Ordering)
-> (EmbedLink a -> EmbedLink a -> Bool)
-> (EmbedLink a -> EmbedLink a -> Bool)
-> (EmbedLink a -> EmbedLink a -> Bool)
-> (EmbedLink a -> EmbedLink a -> Bool)
-> (EmbedLink a -> EmbedLink a -> EmbedLink a)
-> (EmbedLink a -> EmbedLink a -> EmbedLink a)
-> Ord (EmbedLink a)
EmbedLink a -> EmbedLink a -> Bool
EmbedLink a -> EmbedLink a -> Ordering
EmbedLink a -> EmbedLink a -> EmbedLink 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 (EmbedLink a)
forall a. Ord a => EmbedLink a -> EmbedLink a -> Bool
forall a. Ord a => EmbedLink a -> EmbedLink a -> Ordering
forall a. Ord a => EmbedLink a -> EmbedLink a -> EmbedLink a
$ccompare :: forall a. Ord a => EmbedLink a -> EmbedLink a -> Ordering
compare :: EmbedLink a -> EmbedLink a -> Ordering
$c< :: forall a. Ord a => EmbedLink a -> EmbedLink a -> Bool
< :: EmbedLink a -> EmbedLink a -> Bool
$c<= :: forall a. Ord a => EmbedLink a -> EmbedLink a -> Bool
<= :: EmbedLink a -> EmbedLink a -> Bool
$c> :: forall a. Ord a => EmbedLink a -> EmbedLink a -> Bool
> :: EmbedLink a -> EmbedLink a -> Bool
$c>= :: forall a. Ord a => EmbedLink a -> EmbedLink a -> Bool
>= :: EmbedLink a -> EmbedLink a -> Bool
$cmax :: forall a. Ord a => EmbedLink a -> EmbedLink a -> EmbedLink a
max :: EmbedLink a -> EmbedLink a -> EmbedLink a
$cmin :: forall a. Ord a => EmbedLink a -> EmbedLink a -> EmbedLink a
min :: EmbedLink a -> EmbedLink a -> EmbedLink a
Ord, Int -> EmbedLink a -> ShowS
[EmbedLink a] -> ShowS
EmbedLink a -> String
(Int -> EmbedLink a -> ShowS)
-> (EmbedLink a -> String)
-> ([EmbedLink a] -> ShowS)
-> Show (EmbedLink a)
forall a. Show a => Int -> EmbedLink a -> ShowS
forall a. Show a => [EmbedLink a] -> ShowS
forall a. Show a => EmbedLink a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EmbedLink a -> ShowS
showsPrec :: Int -> EmbedLink a -> ShowS
$cshow :: forall a. Show a => EmbedLink a -> String
show :: EmbedLink a -> String
$cshowList :: forall a. Show a => [EmbedLink a] -> ShowS
showList :: [EmbedLink a] -> ShowS
Show, (forall m. Monoid m => EmbedLink m -> m)
-> (forall m a. Monoid m => (a -> m) -> EmbedLink a -> m)
-> (forall m a. Monoid m => (a -> m) -> EmbedLink a -> m)
-> (forall a b. (a -> b -> b) -> b -> EmbedLink a -> b)
-> (forall a b. (a -> b -> b) -> b -> EmbedLink a -> b)
-> (forall b a. (b -> a -> b) -> b -> EmbedLink a -> b)
-> (forall b a. (b -> a -> b) -> b -> EmbedLink a -> b)
-> (forall a. (a -> a -> a) -> EmbedLink a -> a)
-> (forall a. (a -> a -> a) -> EmbedLink a -> a)
-> (forall a. EmbedLink a -> [a])
-> (forall a. EmbedLink a -> Bool)
-> (forall a. EmbedLink a -> Int)
-> (forall a. Eq a => a -> EmbedLink a -> Bool)
-> (forall a. Ord a => EmbedLink a -> a)
-> (forall a. Ord a => EmbedLink a -> a)
-> (forall a. Num a => EmbedLink a -> a)
-> (forall a. Num a => EmbedLink a -> a)
-> Foldable EmbedLink
forall a. Eq a => a -> EmbedLink a -> Bool
forall a. Num a => EmbedLink a -> a
forall a. Ord a => EmbedLink a -> a
forall m. Monoid m => EmbedLink m -> m
forall a. EmbedLink a -> Bool
forall a. EmbedLink a -> Int
forall a. EmbedLink a -> [a]
forall a. (a -> a -> a) -> EmbedLink a -> a
forall m a. Monoid m => (a -> m) -> EmbedLink a -> m
forall b a. (b -> a -> b) -> b -> EmbedLink a -> b
forall a b. (a -> b -> b) -> b -> EmbedLink 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 => EmbedLink m -> m
fold :: forall m. Monoid m => EmbedLink m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EmbedLink a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> EmbedLink a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EmbedLink a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> EmbedLink a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> EmbedLink a -> b
foldr :: forall a b. (a -> b -> b) -> b -> EmbedLink a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EmbedLink a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> EmbedLink a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EmbedLink a -> b
foldl :: forall b a. (b -> a -> b) -> b -> EmbedLink a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EmbedLink a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> EmbedLink a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> EmbedLink a -> a
foldr1 :: forall a. (a -> a -> a) -> EmbedLink a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EmbedLink a -> a
foldl1 :: forall a. (a -> a -> a) -> EmbedLink a -> a
$ctoList :: forall a. EmbedLink a -> [a]
toList :: forall a. EmbedLink a -> [a]
$cnull :: forall a. EmbedLink a -> Bool
null :: forall a. EmbedLink a -> Bool
$clength :: forall a. EmbedLink a -> Int
length :: forall a. EmbedLink a -> Int
$celem :: forall a. Eq a => a -> EmbedLink a -> Bool
elem :: forall a. Eq a => a -> EmbedLink a -> Bool
$cmaximum :: forall a. Ord a => EmbedLink a -> a
maximum :: forall a. Ord a => EmbedLink a -> a
$cminimum :: forall a. Ord a => EmbedLink a -> a
minimum :: forall a. Ord a => EmbedLink a -> a
$csum :: forall a. Num a => EmbedLink a -> a
sum :: forall a. Num a => EmbedLink a -> a
$cproduct :: forall a. Num a => EmbedLink a -> a
product :: forall a. Num a => EmbedLink a -> a
Foldable, (forall a b. (a -> b) -> EmbedLink a -> EmbedLink b)
-> (forall a b. a -> EmbedLink b -> EmbedLink a)
-> Functor EmbedLink
forall a b. a -> EmbedLink b -> EmbedLink a
forall a b. (a -> b) -> EmbedLink a -> EmbedLink 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) -> EmbedLink a -> EmbedLink b
fmap :: forall a b. (a -> b) -> EmbedLink a -> EmbedLink b
$c<$ :: forall a b. a -> EmbedLink b -> EmbedLink a
<$ :: forall a b. a -> EmbedLink b -> EmbedLink a
Functor, Functor EmbedLink
Foldable EmbedLink
(Functor EmbedLink, Foldable EmbedLink) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> EmbedLink a -> f (EmbedLink b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    EmbedLink (f a) -> f (EmbedLink a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> EmbedLink a -> m (EmbedLink b))
-> (forall (m :: * -> *) a.
    Monad m =>
    EmbedLink (m a) -> m (EmbedLink a))
-> Traversable EmbedLink
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 =>
EmbedLink (m a) -> m (EmbedLink a)
forall (f :: * -> *) a.
Applicative f =>
EmbedLink (f a) -> f (EmbedLink a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmbedLink a -> m (EmbedLink b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmbedLink a -> f (EmbedLink b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmbedLink a -> f (EmbedLink b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmbedLink a -> f (EmbedLink b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EmbedLink (f a) -> f (EmbedLink a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
EmbedLink (f a) -> f (EmbedLink a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmbedLink a -> m (EmbedLink b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmbedLink a -> m (EmbedLink b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
EmbedLink (m a) -> m (EmbedLink a)
sequence :: forall (m :: * -> *) a.
Monad m =>
EmbedLink (m a) -> m (EmbedLink a)
Traversable)

$(deriveEq1 ''EmbedLink)
$(deriveOrd1 ''EmbedLink)
$(deriveShow1 ''EmbedLink)

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

$(deriveEq1 ''Transclude)
$(deriveOrd1 ''Transclude)
$(deriveShow1 ''Transclude)

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

$(deriveEq1 ''EmbedAnnotation)
$(deriveOrd1 ''EmbedAnnotation)
$(deriveShow1 ''EmbedAnnotation)
$(deriveEq2 ''EmbedAnnotation)
$(deriveOrd2 ''EmbedAnnotation)
$(deriveShow2 ''EmbedAnnotation)

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

$(deriveEq1 ''SourceElement)
$(deriveOrd1 ''SourceElement)
$(deriveShow1 ''SourceElement)
$(deriveEq2 ''SourceElement)
$(deriveOrd2 ''SourceElement)
$(deriveShow2 ''SourceElement)

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

newtype Word = Word String
  deriving (Word -> Word -> Bool
(Word -> Word -> Bool) -> (Word -> Word -> Bool) -> Eq Word
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word -> Word -> Bool
== :: Word -> Word -> Bool
$c/= :: Word -> Word -> Bool
/= :: Word -> Word -> Bool
Eq, Eq Word
Eq Word =>
(Word -> Word -> Ordering)
-> (Word -> Word -> Bool)
-> (Word -> Word -> Bool)
-> (Word -> Word -> Bool)
-> (Word -> Word -> Bool)
-> (Word -> Word -> Word)
-> (Word -> Word -> Word)
-> Ord Word
Word -> Word -> Bool
Word -> Word -> Ordering
Word -> Word -> Word
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
$ccompare :: Word -> Word -> Ordering
compare :: Word -> Word -> Ordering
$c< :: Word -> Word -> Bool
< :: Word -> Word -> Bool
$c<= :: Word -> Word -> Bool
<= :: Word -> Word -> Bool
$c> :: Word -> Word -> Bool
> :: Word -> Word -> Bool
$c>= :: Word -> Word -> Bool
>= :: Word -> Word -> Bool
$cmax :: Word -> Word -> Word
max :: Word -> Word -> Word
$cmin :: Word -> Word -> Word
min :: Word -> Word -> Word
Ord, Int -> Word -> ShowS
[Word] -> ShowS
Word -> String
(Int -> Word -> ShowS)
-> (Word -> String) -> ([Word] -> ShowS) -> Show Word
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Word -> ShowS
showsPrec :: Int -> Word -> ShowS
$cshow :: Word -> String
show :: Word -> String
$cshowList :: [Word] -> ShowS
showList :: [Word] -> ShowS
Show)

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

$(deriveEq1 ''Join)
$(deriveOrd1 ''Join)
$(deriveShow1 ''Join)

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

$(deriveEq1 ''Group)
$(deriveOrd1 ''Group)
$(deriveShow1 ''Group)

data Leaf ident code a
  = Link (EmbedLink ident)
  | -- | the Group always contains either a single Term/Type link or list of  `Transclude`s & `Word`s
    NamedLink (Paragraph a) (Group a)
  | Example code
  | Transclude' (Transclude code)
  | Bold (Paragraph a)
  | Italic (Paragraph a)
  | Strikethrough (Paragraph a)
  | Verbatim Word
  | Code Word
  | Source (NonEmpty (SourceElement ident (Transclude code)))
  | FoldedSource (NonEmpty (SourceElement ident (Transclude code)))
  | EvalInline code
  | Signature (NonEmpty (EmbedSignatureLink ident))
  | SignatureInline (EmbedSignatureLink ident)
  | Word' Word
  | Group' (Group a)
  deriving (Leaf ident code a -> Leaf ident code a -> Bool
(Leaf ident code a -> Leaf ident code a -> Bool)
-> (Leaf ident code a -> Leaf ident code a -> Bool)
-> Eq (Leaf ident code a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ident code a.
(Eq ident, Eq a, Eq code) =>
Leaf ident code a -> Leaf ident code a -> Bool
$c== :: forall ident code a.
(Eq ident, Eq a, Eq code) =>
Leaf ident code a -> Leaf ident code a -> Bool
== :: Leaf ident code a -> Leaf ident code a -> Bool
$c/= :: forall ident code a.
(Eq ident, Eq a, Eq code) =>
Leaf ident code a -> Leaf ident code a -> Bool
/= :: Leaf ident code a -> Leaf ident code a -> Bool
Eq, Eq (Leaf ident code a)
Eq (Leaf ident code a) =>
(Leaf ident code a -> Leaf ident code a -> Ordering)
-> (Leaf ident code a -> Leaf ident code a -> Bool)
-> (Leaf ident code a -> Leaf ident code a -> Bool)
-> (Leaf ident code a -> Leaf ident code a -> Bool)
-> (Leaf ident code a -> Leaf ident code a -> Bool)
-> (Leaf ident code a -> Leaf ident code a -> Leaf ident code a)
-> (Leaf ident code a -> Leaf ident code a -> Leaf ident code a)
-> Ord (Leaf ident code a)
Leaf ident code a -> Leaf ident code a -> Bool
Leaf ident code a -> Leaf ident code a -> Ordering
Leaf ident code a -> Leaf ident code a -> Leaf ident code 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 ident code a.
(Ord ident, Ord a, Ord code) =>
Eq (Leaf ident code a)
forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Bool
forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Ordering
forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Leaf ident code a
$ccompare :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Ordering
compare :: Leaf ident code a -> Leaf ident code a -> Ordering
$c< :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Bool
< :: Leaf ident code a -> Leaf ident code a -> Bool
$c<= :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Bool
<= :: Leaf ident code a -> Leaf ident code a -> Bool
$c> :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Bool
> :: Leaf ident code a -> Leaf ident code a -> Bool
$c>= :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Bool
>= :: Leaf ident code a -> Leaf ident code a -> Bool
$cmax :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Leaf ident code a
max :: Leaf ident code a -> Leaf ident code a -> Leaf ident code a
$cmin :: forall ident code a.
(Ord ident, Ord a, Ord code) =>
Leaf ident code a -> Leaf ident code a -> Leaf ident code a
min :: Leaf ident code a -> Leaf ident code a -> Leaf ident code a
Ord, Int -> Leaf ident code a -> ShowS
[Leaf ident code a] -> ShowS
Leaf ident code a -> String
(Int -> Leaf ident code a -> ShowS)
-> (Leaf ident code a -> String)
-> ([Leaf ident code a] -> ShowS)
-> Show (Leaf ident code a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ident code a.
(Show ident, Show a, Show code) =>
Int -> Leaf ident code a -> ShowS
forall ident code a.
(Show ident, Show a, Show code) =>
[Leaf ident code a] -> ShowS
forall ident code a.
(Show ident, Show a, Show code) =>
Leaf ident code a -> String
$cshowsPrec :: forall ident code a.
(Show ident, Show a, Show code) =>
Int -> Leaf ident code a -> ShowS
showsPrec :: Int -> Leaf ident code a -> ShowS
$cshow :: forall ident code a.
(Show ident, Show a, Show code) =>
Leaf ident code a -> String
show :: Leaf ident code a -> String
$cshowList :: forall ident code a.
(Show ident, Show a, Show code) =>
[Leaf ident code a] -> ShowS
showList :: [Leaf ident code a] -> ShowS
Show, (forall m. Monoid m => Leaf ident code m -> m)
-> (forall m a. Monoid m => (a -> m) -> Leaf ident code a -> m)
-> (forall m a. Monoid m => (a -> m) -> Leaf ident code a -> m)
-> (forall a b. (a -> b -> b) -> b -> Leaf ident code a -> b)
-> (forall a b. (a -> b -> b) -> b -> Leaf ident code a -> b)
-> (forall b a. (b -> a -> b) -> b -> Leaf ident code a -> b)
-> (forall b a. (b -> a -> b) -> b -> Leaf ident code a -> b)
-> (forall a. (a -> a -> a) -> Leaf ident code a -> a)
-> (forall a. (a -> a -> a) -> Leaf ident code a -> a)
-> (forall a. Leaf ident code a -> [a])
-> (forall a. Leaf ident code a -> Bool)
-> (forall a. Leaf ident code a -> Int)
-> (forall a. Eq a => a -> Leaf ident code a -> Bool)
-> (forall a. Ord a => Leaf ident code a -> a)
-> (forall a. Ord a => Leaf ident code a -> a)
-> (forall a. Num a => Leaf ident code a -> a)
-> (forall a. Num a => Leaf ident code a -> a)
-> Foldable (Leaf ident code)
forall a. Eq a => a -> Leaf ident code a -> Bool
forall a. Num a => Leaf ident code a -> a
forall a. Ord a => Leaf ident code a -> a
forall m. Monoid m => Leaf ident code m -> m
forall a. Leaf ident code a -> Bool
forall a. Leaf ident code a -> Int
forall a. Leaf ident code a -> [a]
forall a. (a -> a -> a) -> Leaf ident code a -> a
forall m a. Monoid m => (a -> m) -> Leaf ident code a -> m
forall b a. (b -> a -> b) -> b -> Leaf ident code a -> b
forall a b. (a -> b -> b) -> b -> Leaf ident code a -> b
forall ident code a. Eq a => a -> Leaf ident code a -> Bool
forall ident code a. Num a => Leaf ident code a -> a
forall ident code a. Ord a => Leaf ident code a -> a
forall ident code m. Monoid m => Leaf ident code m -> m
forall ident code a. Leaf ident code a -> Bool
forall ident code a. Leaf ident code a -> Int
forall ident code a. Leaf ident code a -> [a]
forall ident code a. (a -> a -> a) -> Leaf ident code a -> a
forall ident code m a.
Monoid m =>
(a -> m) -> Leaf ident code a -> m
forall ident code b a. (b -> a -> b) -> b -> Leaf ident code a -> b
forall ident code a b. (a -> b -> b) -> b -> Leaf ident code 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 ident code m. Monoid m => Leaf ident code m -> m
fold :: forall m. Monoid m => Leaf ident code m -> m
$cfoldMap :: forall ident code m a.
Monoid m =>
(a -> m) -> Leaf ident code a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Leaf ident code a -> m
$cfoldMap' :: forall ident code m a.
Monoid m =>
(a -> m) -> Leaf ident code a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Leaf ident code a -> m
$cfoldr :: forall ident code a b. (a -> b -> b) -> b -> Leaf ident code a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Leaf ident code a -> b
$cfoldr' :: forall ident code a b. (a -> b -> b) -> b -> Leaf ident code a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Leaf ident code a -> b
$cfoldl :: forall ident code b a. (b -> a -> b) -> b -> Leaf ident code a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Leaf ident code a -> b
$cfoldl' :: forall ident code b a. (b -> a -> b) -> b -> Leaf ident code a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Leaf ident code a -> b
$cfoldr1 :: forall ident code a. (a -> a -> a) -> Leaf ident code a -> a
foldr1 :: forall a. (a -> a -> a) -> Leaf ident code a -> a
$cfoldl1 :: forall ident code a. (a -> a -> a) -> Leaf ident code a -> a
foldl1 :: forall a. (a -> a -> a) -> Leaf ident code a -> a
$ctoList :: forall ident code a. Leaf ident code a -> [a]
toList :: forall a. Leaf ident code a -> [a]
$cnull :: forall ident code a. Leaf ident code a -> Bool
null :: forall a. Leaf ident code a -> Bool
$clength :: forall ident code a. Leaf ident code a -> Int
length :: forall a. Leaf ident code a -> Int
$celem :: forall ident code a. Eq a => a -> Leaf ident code a -> Bool
elem :: forall a. Eq a => a -> Leaf ident code a -> Bool
$cmaximum :: forall ident code a. Ord a => Leaf ident code a -> a
maximum :: forall a. Ord a => Leaf ident code a -> a
$cminimum :: forall ident code a. Ord a => Leaf ident code a -> a
minimum :: forall a. Ord a => Leaf ident code a -> a
$csum :: forall ident code a. Num a => Leaf ident code a -> a
sum :: forall a. Num a => Leaf ident code a -> a
$cproduct :: forall ident code a. Num a => Leaf ident code a -> a
product :: forall a. Num a => Leaf ident code a -> a
Foldable, (forall a b. (a -> b) -> Leaf ident code a -> Leaf ident code b)
-> (forall a b. a -> Leaf ident code b -> Leaf ident code a)
-> Functor (Leaf ident code)
forall a b. a -> Leaf ident code b -> Leaf ident code a
forall a b. (a -> b) -> Leaf ident code a -> Leaf ident code b
forall ident code a b. a -> Leaf ident code b -> Leaf ident code a
forall ident code a b.
(a -> b) -> Leaf ident code a -> Leaf ident code b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ident code a b.
(a -> b) -> Leaf ident code a -> Leaf ident code b
fmap :: forall a b. (a -> b) -> Leaf ident code a -> Leaf ident code b
$c<$ :: forall ident code a b. a -> Leaf ident code b -> Leaf ident code a
<$ :: forall a b. a -> Leaf ident code b -> Leaf ident code a
Functor, Functor (Leaf ident code)
Foldable (Leaf ident code)
(Functor (Leaf ident code), Foldable (Leaf ident code)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Leaf ident code a -> f (Leaf ident code b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Leaf ident code (f a) -> f (Leaf ident code a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Leaf ident code a -> m (Leaf ident code b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Leaf ident code (m a) -> m (Leaf ident code a))
-> Traversable (Leaf ident code)
forall ident code. Functor (Leaf ident code)
forall ident code. Foldable (Leaf ident code)
forall ident code (m :: * -> *) a.
Monad m =>
Leaf ident code (m a) -> m (Leaf ident code a)
forall ident code (f :: * -> *) a.
Applicative f =>
Leaf ident code (f a) -> f (Leaf ident code a)
forall ident code (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Leaf ident code a -> m (Leaf ident code b)
forall ident code (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Leaf ident code a -> f (Leaf ident code b)
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 =>
Leaf ident code (m a) -> m (Leaf ident code a)
forall (f :: * -> *) a.
Applicative f =>
Leaf ident code (f a) -> f (Leaf ident code a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Leaf ident code a -> m (Leaf ident code b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Leaf ident code a -> f (Leaf ident code b)
$ctraverse :: forall ident code (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Leaf ident code a -> f (Leaf ident code b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Leaf ident code a -> f (Leaf ident code b)
$csequenceA :: forall ident code (f :: * -> *) a.
Applicative f =>
Leaf ident code (f a) -> f (Leaf ident code a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Leaf ident code (f a) -> f (Leaf ident code a)
$cmapM :: forall ident code (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Leaf ident code a -> m (Leaf ident code b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Leaf ident code a -> m (Leaf ident code b)
$csequence :: forall ident code (m :: * -> *) a.
Monad m =>
Leaf ident code (m a) -> m (Leaf ident code a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Leaf ident code (m a) -> m (Leaf ident code a)
Traversable)

instance Bifunctor (Leaf ident) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Leaf ident a c -> Leaf ident b d
bimap a -> b
f c -> d
g = \case
    Link EmbedLink ident
x -> EmbedLink ident -> Leaf ident b d
forall ident code a. EmbedLink ident -> Leaf ident code a
Link EmbedLink ident
x
    NamedLink Paragraph c
para Group c
group -> Paragraph d -> Group d -> Leaf ident b d
forall ident code a. Paragraph a -> Group a -> Leaf ident code a
NamedLink (c -> d
g (c -> d) -> Paragraph c -> Paragraph d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Paragraph c
para) (Group d -> Leaf ident b d) -> Group d -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ c -> d
g (c -> d) -> Group c -> Group d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Group c
group
    Example a
code -> b -> Leaf ident b d
forall ident code a. code -> Leaf ident code a
Example (b -> Leaf ident b d) -> b -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ a -> b
f a
code
    Transclude' Transclude a
trans -> Transclude b -> Leaf ident b d
forall ident code a. Transclude code -> Leaf ident code a
Transclude' (Transclude b -> Leaf ident b d) -> Transclude b -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> Transclude a -> Transclude b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transclude a
trans
    Bold Paragraph c
para -> Paragraph d -> Leaf ident b d
forall ident code a. Paragraph a -> Leaf ident code a
Bold (Paragraph d -> Leaf ident b d) -> Paragraph d -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ c -> d
g (c -> d) -> Paragraph c -> Paragraph d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Paragraph c
para
    Italic Paragraph c
para -> Paragraph d -> Leaf ident b d
forall ident code a. Paragraph a -> Leaf ident code a
Italic (Paragraph d -> Leaf ident b d) -> Paragraph d -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ c -> d
g (c -> d) -> Paragraph c -> Paragraph d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Paragraph c
para
    Strikethrough Paragraph c
para -> Paragraph d -> Leaf ident b d
forall ident code a. Paragraph a -> Leaf ident code a
Strikethrough (Paragraph d -> Leaf ident b d) -> Paragraph d -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ c -> d
g (c -> d) -> Paragraph c -> Paragraph d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Paragraph c
para
    Verbatim Word
word -> Word -> Leaf ident b d
forall ident code a. Word -> Leaf ident code a
Verbatim Word
word
    Code Word
word -> Word -> Leaf ident b d
forall ident code a. Word -> Leaf ident code a
Code Word
word
    Source NonEmpty (SourceElement ident (Transclude a))
elems -> NonEmpty (SourceElement ident (Transclude b)) -> Leaf ident b d
forall ident code a.
NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
Source (NonEmpty (SourceElement ident (Transclude b)) -> Leaf ident b d)
-> NonEmpty (SourceElement ident (Transclude b)) -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ (Transclude a -> Transclude b)
-> SourceElement ident (Transclude a)
-> SourceElement ident (Transclude b)
forall a b.
(a -> b) -> SourceElement ident a -> SourceElement ident b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Transclude a -> Transclude b
forall a b. (a -> b) -> Transclude a -> Transclude b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (SourceElement ident (Transclude a)
 -> SourceElement ident (Transclude b))
-> NonEmpty (SourceElement ident (Transclude a))
-> NonEmpty (SourceElement ident (Transclude b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (SourceElement ident (Transclude a))
elems
    FoldedSource NonEmpty (SourceElement ident (Transclude a))
elems -> NonEmpty (SourceElement ident (Transclude b)) -> Leaf ident b d
forall ident code a.
NonEmpty (SourceElement ident (Transclude code))
-> Leaf ident code a
FoldedSource (NonEmpty (SourceElement ident (Transclude b)) -> Leaf ident b d)
-> NonEmpty (SourceElement ident (Transclude b)) -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ (Transclude a -> Transclude b)
-> SourceElement ident (Transclude a)
-> SourceElement ident (Transclude b)
forall a b.
(a -> b) -> SourceElement ident a -> SourceElement ident b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Transclude a -> Transclude b
forall a b. (a -> b) -> Transclude a -> Transclude b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (SourceElement ident (Transclude a)
 -> SourceElement ident (Transclude b))
-> NonEmpty (SourceElement ident (Transclude a))
-> NonEmpty (SourceElement ident (Transclude b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (SourceElement ident (Transclude a))
elems
    EvalInline a
code -> b -> Leaf ident b d
forall ident code a. code -> Leaf ident code a
EvalInline (b -> Leaf ident b d) -> b -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ a -> b
f a
code
    Signature NonEmpty (EmbedSignatureLink ident)
x -> NonEmpty (EmbedSignatureLink ident) -> Leaf ident b d
forall ident code a.
NonEmpty (EmbedSignatureLink ident) -> Leaf ident code a
Signature NonEmpty (EmbedSignatureLink ident)
x
    SignatureInline EmbedSignatureLink ident
x -> EmbedSignatureLink ident -> Leaf ident b d
forall ident code a. EmbedSignatureLink ident -> Leaf ident code a
SignatureInline EmbedSignatureLink ident
x
    Word' Word
word -> Word -> Leaf ident b d
forall ident code a. Word -> Leaf ident code a
Word' Word
word
    Group' Group c
group -> Group d -> Leaf ident b d
forall ident code a. Group a -> Leaf ident code a
Group' (Group d -> Leaf ident b d) -> Group d -> Leaf ident b d
forall a b. (a -> b) -> a -> b
$ c -> d
g (c -> d) -> Group c -> Group d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Group c
group

$(deriveEq1 ''Leaf)
$(deriveOrd1 ''Leaf)
$(deriveShow1 ''Leaf)
$(deriveEq2 ''Leaf)
$(deriveOrd2 ''Leaf)
$(deriveShow2 ''Leaf)