-- | Bases in the cohomology of the spaces appearing in the computations.
--
-- We have three different spaces: 
--
-- * @Q^n = P^1 x P^1 x ... x P^1@ (@n@ times; @m = length lambda@)
--
-- * @Q^m = P^1 x P^1 x ... x P^1 x P^1@ (@m@ times, @m = sum lambda >= n@)
-- 
-- * @P^m = P(Sym^m C^2)@
--
-- Furthermore, we have @GL2@ acting naturally on these spaces.
--

{-# LANGUAGE 
      BangPatterns, TypeSynonymInstances, FlexibleInstances, DeriveFunctor, 
      ScopedTypeVariables, Rank2Types 
  #-}
module Math.RootLoci.Geometry.Cohomology where

--------------------------------------------------------------------------------

import Data.List
import Data.Monoid

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)     
import Data.Foldable
import Data.Semigroup
#endif

import Math.Combinat.Numbers

import qualified Data.Map as Map
import qualified Data.Set as Set

import qualified Math.Algebra.Polynomial.FreeModule as ZMod
import Math.Algebra.Polynomial.FreeModule ( ZMod , FreeMod(..) , unFreeMod )

import Math.RootLoci.Algebra.SymmPoly 
import Math.Algebra.Polynomial.Pretty

--------------------------------------------------------------------------------
-- * The non-equivariant case

-- | a (ring) generator of @H^*(Q^n)@ (note that @u_i^2 = 0@)
newtype U = U Int deriving (U -> U -> Bool
(U -> U -> Bool) -> (U -> U -> Bool) -> Eq U
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: U -> U -> Bool
$c/= :: U -> U -> Bool
== :: U -> U -> Bool
$c== :: U -> U -> Bool
Eq,Eq U
Eq U
-> (U -> U -> Ordering)
-> (U -> U -> Bool)
-> (U -> U -> Bool)
-> (U -> U -> Bool)
-> (U -> U -> Bool)
-> (U -> U -> U)
-> (U -> U -> U)
-> Ord U
U -> U -> Bool
U -> U -> Ordering
U -> U -> U
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
min :: U -> U -> U
$cmin :: U -> U -> U
max :: U -> U -> U
$cmax :: U -> U -> U
>= :: U -> U -> Bool
$c>= :: U -> U -> Bool
> :: U -> U -> Bool
$c> :: U -> U -> Bool
<= :: U -> U -> Bool
$c<= :: U -> U -> Bool
< :: U -> U -> Bool
$c< :: U -> U -> Bool
compare :: U -> U -> Ordering
$ccompare :: U -> U -> Ordering
$cp1Ord :: Eq U
Ord,Int -> U -> ShowS
[U] -> ShowS
U -> String
(Int -> U -> ShowS) -> (U -> String) -> ([U] -> ShowS) -> Show U
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [U] -> ShowS
$cshowList :: [U] -> ShowS
show :: U -> String
$cshow :: U -> String
showsPrec :: Int -> U -> ShowS
$cshowsPrec :: Int -> U -> ShowS
Show)

-- | (a ring) generator of @H^*(Q^m)@ (note that @h_i^2 = 0@)
newtype H = H Int deriving (H -> H -> Bool
(H -> H -> Bool) -> (H -> H -> Bool) -> Eq H
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: H -> H -> Bool
$c/= :: H -> H -> Bool
== :: H -> H -> Bool
$c== :: H -> H -> Bool
Eq,Eq H
Eq H
-> (H -> H -> Ordering)
-> (H -> H -> Bool)
-> (H -> H -> Bool)
-> (H -> H -> Bool)
-> (H -> H -> Bool)
-> (H -> H -> H)
-> (H -> H -> H)
-> Ord H
H -> H -> Bool
H -> H -> Ordering
H -> H -> H
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
min :: H -> H -> H
$cmin :: H -> H -> H
max :: H -> H -> H
$cmax :: H -> H -> H
>= :: H -> H -> Bool
$c>= :: H -> H -> Bool
> :: H -> H -> Bool
$c> :: H -> H -> Bool
<= :: H -> H -> Bool
$c<= :: H -> H -> Bool
< :: H -> H -> Bool
$c< :: H -> H -> Bool
compare :: H -> H -> Ordering
$ccompare :: H -> H -> Ordering
$cp1Ord :: Eq H
Ord,Int -> H -> ShowS
[H] -> ShowS
H -> String
(Int -> H -> ShowS) -> (H -> String) -> ([H] -> ShowS) -> Show H
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [H] -> ShowS
$cshowList :: [H] -> ShowS
show :: H -> String
$cshow :: H -> String
showsPrec :: Int -> H -> ShowS
$cshowsPrec :: Int -> H -> ShowS
Show)

-- | the generator of @H^*(P^n)@ (with @g^(n+1) = 0@)
newtype G = G Int deriving (G -> G -> Bool
(G -> G -> Bool) -> (G -> G -> Bool) -> Eq G
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: G -> G -> Bool
$c/= :: G -> G -> Bool
== :: G -> G -> Bool
$c== :: G -> G -> Bool
Eq,Eq G
Eq G
-> (G -> G -> Ordering)
-> (G -> G -> Bool)
-> (G -> G -> Bool)
-> (G -> G -> Bool)
-> (G -> G -> Bool)
-> (G -> G -> G)
-> (G -> G -> G)
-> Ord G
G -> G -> Bool
G -> G -> Ordering
G -> G -> G
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
min :: G -> G -> G
$cmin :: G -> G -> G
max :: G -> G -> G
$cmax :: G -> G -> G
>= :: G -> G -> Bool
$c>= :: G -> G -> Bool
> :: G -> G -> Bool
$c> :: G -> G -> Bool
<= :: G -> G -> Bool
$c<= :: G -> G -> Bool
< :: G -> G -> Bool
$c< :: G -> G -> Bool
compare :: G -> G -> Ordering
$ccompare :: G -> G -> Ordering
$cp1Ord :: Eq G
Ord,Int -> G -> ShowS
[G] -> ShowS
G -> String
(Int -> G -> ShowS) -> (G -> String) -> ([G] -> ShowS) -> Show G
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [G] -> ShowS
$cshowList :: [G] -> ShowS
show :: G -> String
$cshow :: G -> String
showsPrec :: Int -> G -> ShowS
$cshowsPrec :: Int -> G -> ShowS
Show)

-- | A monomial in @u_i@ (encoded as a subset of @[1..n]@, as @u_i^2=0@)
newtype US = US [U] deriving (US -> US -> Bool
(US -> US -> Bool) -> (US -> US -> Bool) -> Eq US
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: US -> US -> Bool
$c/= :: US -> US -> Bool
== :: US -> US -> Bool
$c== :: US -> US -> Bool
Eq,Eq US
Eq US
-> (US -> US -> Ordering)
-> (US -> US -> Bool)
-> (US -> US -> Bool)
-> (US -> US -> Bool)
-> (US -> US -> Bool)
-> (US -> US -> US)
-> (US -> US -> US)
-> Ord US
US -> US -> Bool
US -> US -> Ordering
US -> US -> US
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
min :: US -> US -> US
$cmin :: US -> US -> US
max :: US -> US -> US
$cmax :: US -> US -> US
>= :: US -> US -> Bool
$c>= :: US -> US -> Bool
> :: US -> US -> Bool
$c> :: US -> US -> Bool
<= :: US -> US -> Bool
$c<= :: US -> US -> Bool
< :: US -> US -> Bool
$c< :: US -> US -> Bool
compare :: US -> US -> Ordering
$ccompare :: US -> US -> Ordering
$cp1Ord :: Eq US
Ord,Int -> US -> ShowS
[US] -> ShowS
US -> String
(Int -> US -> ShowS)
-> (US -> String) -> ([US] -> ShowS) -> Show US
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [US] -> ShowS
$cshowList :: [US] -> ShowS
show :: US -> String
$cshow :: US -> String
showsPrec :: Int -> US -> ShowS
$cshowsPrec :: Int -> US -> ShowS
Show)

-- | A monomial in @h_i@ (encoded as a subset of @[1..m]@, as @h_i^2=0@)
newtype HS = HS [H] deriving (HS -> HS -> Bool
(HS -> HS -> Bool) -> (HS -> HS -> Bool) -> Eq HS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HS -> HS -> Bool
$c/= :: HS -> HS -> Bool
== :: HS -> HS -> Bool
$c== :: HS -> HS -> Bool
Eq,Eq HS
Eq HS
-> (HS -> HS -> Ordering)
-> (HS -> HS -> Bool)
-> (HS -> HS -> Bool)
-> (HS -> HS -> Bool)
-> (HS -> HS -> Bool)
-> (HS -> HS -> HS)
-> (HS -> HS -> HS)
-> Ord HS
HS -> HS -> Bool
HS -> HS -> Ordering
HS -> HS -> HS
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
min :: HS -> HS -> HS
$cmin :: HS -> HS -> HS
max :: HS -> HS -> HS
$cmax :: HS -> HS -> HS
>= :: HS -> HS -> Bool
$c>= :: HS -> HS -> Bool
> :: HS -> HS -> Bool
$c> :: HS -> HS -> Bool
<= :: HS -> HS -> Bool
$c<= :: HS -> HS -> Bool
< :: HS -> HS -> Bool
$c< :: HS -> HS -> Bool
compare :: HS -> HS -> Ordering
$ccompare :: HS -> HS -> Ordering
$cp1Ord :: Eq HS
Ord,Int -> HS -> ShowS
[HS] -> ShowS
HS -> String
(Int -> HS -> ShowS)
-> (HS -> String) -> ([HS] -> ShowS) -> Show HS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HS] -> ShowS
$cshowList :: [HS] -> ShowS
show :: HS -> String
$cshow :: HS -> String
showsPrec :: Int -> HS -> ShowS
$cshowsPrec :: Int -> HS -> ShowS
Show)

--------------------------------------------------------------------------------

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)     

instance Semigroup US where
  (US [U]
us1) <> :: US -> US -> US
<> (US [U]
us2) = 
    if [U] -> [U]
forall a. Eq a => [a] -> [a]
nub [U]
us3 [U] -> [U] -> Bool
forall a. Eq a => a -> a -> Bool
== [U]
us3
      then [U] -> US
US [U]
us3
      else String -> US
forall a. HasCallStack => String -> a
error String
"[U]/monoid: duplicate indices"
    where
      us3 :: [U]
us3 = [U] -> [U]
forall a. Ord a => [a] -> [a]
sort ([U]
us1 [U] -> [U] -> [U]
forall a. [a] -> [a] -> [a]
++ [U]
us2)

instance Semigroup HS where
  (HS [H]
hs1) <> :: HS -> HS -> HS
<> (HS [H]
hs2) = 
    if [H] -> [H]
forall a. Eq a => [a] -> [a]
nub [H]
hs3 [H] -> [H] -> Bool
forall a. Eq a => a -> a -> Bool
== [H]
hs3
      then [H] -> HS
HS [H]
hs3
      else String -> HS
forall a. HasCallStack => String -> a
error String
"[H]/monoid: duplicate indices"
    where
      hs3 :: [H]
hs3 = [H] -> [H]
forall a. Ord a => [a] -> [a]
sort ([H]
hs1 [H] -> [H] -> [H]
forall a. [a] -> [a] -> [a]
++ [H]
hs2)

instance Semigroup G where
  (G Int
e) <> :: G -> G -> G
<> (G Int
f) = Int -> G
G (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f)

instance Monoid US where
  mempty :: US
mempty = [U] -> US
US []

instance Monoid HS where
  mempty :: HS
mempty = [H] -> HS
HS []

instance Monoid G where
  mempty :: G
mempty = Int -> G
G Int
0

#else

instance Monoid US where
  mempty = US []
  (US us1) `mappend` (US us2) = 
    if nub us3 == us3
      then US us3
      else error "[U]/monoid: duplicate indices"
    where
      us3 = sort (us1 ++ us2)

instance Monoid HS where
  mempty = HS []
  (HS hs1) `mappend` (HS hs2) = 
    if nub hs3 == hs3
      then HS hs3
      else error "[H]/monoid: duplicate indices"
    where
      hs3 = sort (hs1 ++ hs2)

instance Monoid G where
  mempty = G 0
  (G e) `mappend` (G f) = G (e+f)

#endif
 
--------------------------------------------------------------------------------

instance Pretty G where
  pretty :: G -> String
pretty (G Int
e) = String
"g^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
e

instance Pretty H where
  pretty :: H -> String
pretty (H Int
i) = String
"h" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

instance Pretty U where
  pretty :: U -> String
pretty (U Int
i) = String
"u" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

instance Pretty HS where
  pretty :: HS -> String
pretty (HS []) = String
""
  pretty (HS [H]
hs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" ((H -> String) -> [H] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map H -> String
forall a. Pretty a => a -> String
pretty [H]
hs)

instance Pretty US where
  pretty :: US -> String
pretty (US []) = String
""
  pretty (US [U]
us) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" ((U -> String) -> [U] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map U -> String
forall a. Pretty a => a -> String
pretty [U]
us)

--------------------------------------------------------------------------------

instance Graded U where grade :: U -> Int
grade U
_ = Int
1
instance Graded H where grade :: H -> Int
grade H
_ = Int
1
instance Graded G where grade :: G -> Int
grade (G Int
g) = Int
g
instance Graded HS where grade :: HS -> Int
grade (HS [H]
js) = [H] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [H]
js
instance Graded US where grade :: US -> Int
grade (US [U]
js) = [U] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [U]
js

instance Graded ab => Graded (Omega ab) where grade :: Omega ab -> Int
grade (Omega [Int]
us ab
ab) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
us Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ab -> Int
forall a. Graded a => a -> Int
grade ab
ab
instance Graded ab => Graded (Eta   ab) where grade :: Eta ab -> Int
grade (Eta   [Int]
hs ab
ab) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
hs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ab -> Int
forall a. Graded a => a -> Int
grade ab
ab
instance Graded ab => Graded (Gam   ab) where grade :: Gam ab -> Int
grade (Gam   Int
g  ab
ab) = Int
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ab -> Int
forall a. Graded a => a -> Int
grade ab
ab

--------------------------------------------------------------------------------
-- * The equivariant case

-- | A monomial generator of @Z[alpha,beta;u1,u2,...,u_nd]/(...)@, 
-- the cohomology ring of @Q^n@. 
--
-- The encoding is that the list is the list of indices of @u@ which appear.
data Omega ab = Omega ![Int] !ab deriving (Omega ab -> Omega ab -> Bool
(Omega ab -> Omega ab -> Bool)
-> (Omega ab -> Omega ab -> Bool) -> Eq (Omega ab)
forall ab. Eq ab => Omega ab -> Omega ab -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Omega ab -> Omega ab -> Bool
$c/= :: forall ab. Eq ab => Omega ab -> Omega ab -> Bool
== :: Omega ab -> Omega ab -> Bool
$c== :: forall ab. Eq ab => Omega ab -> Omega ab -> Bool
Eq,Eq (Omega ab)
Eq (Omega ab)
-> (Omega ab -> Omega ab -> Ordering)
-> (Omega ab -> Omega ab -> Bool)
-> (Omega ab -> Omega ab -> Bool)
-> (Omega ab -> Omega ab -> Bool)
-> (Omega ab -> Omega ab -> Bool)
-> (Omega ab -> Omega ab -> Omega ab)
-> (Omega ab -> Omega ab -> Omega ab)
-> Ord (Omega ab)
Omega ab -> Omega ab -> Bool
Omega ab -> Omega ab -> Ordering
Omega ab -> Omega ab -> Omega ab
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 ab. Ord ab => Eq (Omega ab)
forall ab. Ord ab => Omega ab -> Omega ab -> Bool
forall ab. Ord ab => Omega ab -> Omega ab -> Ordering
forall ab. Ord ab => Omega ab -> Omega ab -> Omega ab
min :: Omega ab -> Omega ab -> Omega ab
$cmin :: forall ab. Ord ab => Omega ab -> Omega ab -> Omega ab
max :: Omega ab -> Omega ab -> Omega ab
$cmax :: forall ab. Ord ab => Omega ab -> Omega ab -> Omega ab
>= :: Omega ab -> Omega ab -> Bool
$c>= :: forall ab. Ord ab => Omega ab -> Omega ab -> Bool
> :: Omega ab -> Omega ab -> Bool
$c> :: forall ab. Ord ab => Omega ab -> Omega ab -> Bool
<= :: Omega ab -> Omega ab -> Bool
$c<= :: forall ab. Ord ab => Omega ab -> Omega ab -> Bool
< :: Omega ab -> Omega ab -> Bool
$c< :: forall ab. Ord ab => Omega ab -> Omega ab -> Bool
compare :: Omega ab -> Omega ab -> Ordering
$ccompare :: forall ab. Ord ab => Omega ab -> Omega ab -> Ordering
$cp1Ord :: forall ab. Ord ab => Eq (Omega ab)
Ord,Int -> Omega ab -> ShowS
[Omega ab] -> ShowS
Omega ab -> String
(Int -> Omega ab -> ShowS)
-> (Omega ab -> String) -> ([Omega ab] -> ShowS) -> Show (Omega ab)
forall ab. Show ab => Int -> Omega ab -> ShowS
forall ab. Show ab => [Omega ab] -> ShowS
forall ab. Show ab => Omega ab -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Omega ab] -> ShowS
$cshowList :: forall ab. Show ab => [Omega ab] -> ShowS
show :: Omega ab -> String
$cshow :: forall ab. Show ab => Omega ab -> String
showsPrec :: Int -> Omega ab -> ShowS
$cshowsPrec :: forall ab. Show ab => Int -> Omega ab -> ShowS
Show,a -> Omega b -> Omega a
(a -> b) -> Omega a -> Omega b
(forall a b. (a -> b) -> Omega a -> Omega b)
-> (forall a b. a -> Omega b -> Omega a) -> Functor Omega
forall a b. a -> Omega b -> Omega a
forall a b. (a -> b) -> Omega a -> Omega b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Omega b -> Omega a
$c<$ :: forall a b. a -> Omega b -> Omega a
fmap :: (a -> b) -> Omega a -> Omega b
$cfmap :: forall a b. (a -> b) -> Omega a -> Omega b
Functor)

-- | A monomial generator of @Z[alpha,beta;eta1,eta2...eta_m]/(...)@,
-- he cohomology ring of @Q^m@. 
--
-- The encoding is that the list is the list of indices of @eta@ which appear.
data Eta ab = Eta ![Int] !ab deriving (Eta ab -> Eta ab -> Bool
(Eta ab -> Eta ab -> Bool)
-> (Eta ab -> Eta ab -> Bool) -> Eq (Eta ab)
forall ab. Eq ab => Eta ab -> Eta ab -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Eta ab -> Eta ab -> Bool
$c/= :: forall ab. Eq ab => Eta ab -> Eta ab -> Bool
== :: Eta ab -> Eta ab -> Bool
$c== :: forall ab. Eq ab => Eta ab -> Eta ab -> Bool
Eq,Eq (Eta ab)
Eq (Eta ab)
-> (Eta ab -> Eta ab -> Ordering)
-> (Eta ab -> Eta ab -> Bool)
-> (Eta ab -> Eta ab -> Bool)
-> (Eta ab -> Eta ab -> Bool)
-> (Eta ab -> Eta ab -> Bool)
-> (Eta ab -> Eta ab -> Eta ab)
-> (Eta ab -> Eta ab -> Eta ab)
-> Ord (Eta ab)
Eta ab -> Eta ab -> Bool
Eta ab -> Eta ab -> Ordering
Eta ab -> Eta ab -> Eta ab
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 ab. Ord ab => Eq (Eta ab)
forall ab. Ord ab => Eta ab -> Eta ab -> Bool
forall ab. Ord ab => Eta ab -> Eta ab -> Ordering
forall ab. Ord ab => Eta ab -> Eta ab -> Eta ab
min :: Eta ab -> Eta ab -> Eta ab
$cmin :: forall ab. Ord ab => Eta ab -> Eta ab -> Eta ab
max :: Eta ab -> Eta ab -> Eta ab
$cmax :: forall ab. Ord ab => Eta ab -> Eta ab -> Eta ab
>= :: Eta ab -> Eta ab -> Bool
$c>= :: forall ab. Ord ab => Eta ab -> Eta ab -> Bool
> :: Eta ab -> Eta ab -> Bool
$c> :: forall ab. Ord ab => Eta ab -> Eta ab -> Bool
<= :: Eta ab -> Eta ab -> Bool
$c<= :: forall ab. Ord ab => Eta ab -> Eta ab -> Bool
< :: Eta ab -> Eta ab -> Bool
$c< :: forall ab. Ord ab => Eta ab -> Eta ab -> Bool
compare :: Eta ab -> Eta ab -> Ordering
$ccompare :: forall ab. Ord ab => Eta ab -> Eta ab -> Ordering
$cp1Ord :: forall ab. Ord ab => Eq (Eta ab)
Ord,Int -> Eta ab -> ShowS
[Eta ab] -> ShowS
Eta ab -> String
(Int -> Eta ab -> ShowS)
-> (Eta ab -> String) -> ([Eta ab] -> ShowS) -> Show (Eta ab)
forall ab. Show ab => Int -> Eta ab -> ShowS
forall ab. Show ab => [Eta ab] -> ShowS
forall ab. Show ab => Eta ab -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Eta ab] -> ShowS
$cshowList :: forall ab. Show ab => [Eta ab] -> ShowS
show :: Eta ab -> String
$cshow :: forall ab. Show ab => Eta ab -> String
showsPrec :: Int -> Eta ab -> ShowS
$cshowsPrec :: forall ab. Show ab => Int -> Eta ab -> ShowS
Show,a -> Eta b -> Eta a
(a -> b) -> Eta a -> Eta b
(forall a b. (a -> b) -> Eta a -> Eta b)
-> (forall a b. a -> Eta b -> Eta a) -> Functor Eta
forall a b. a -> Eta b -> Eta a
forall a b. (a -> b) -> Eta a -> Eta b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Eta b -> Eta a
$c<$ :: forall a b. a -> Eta b -> Eta a
fmap :: (a -> b) -> Eta a -> Eta b
$cfmap :: forall a b. (a -> b) -> Eta a -> Eta b
Functor)

-- | A monomial generator of @Z[alpha,beta;gamma]/(...)@,
-- the cohomology ring of @P^m@. 
data Gam ab = Gam !Int !ab deriving (Gam ab -> Gam ab -> Bool
(Gam ab -> Gam ab -> Bool)
-> (Gam ab -> Gam ab -> Bool) -> Eq (Gam ab)
forall ab. Eq ab => Gam ab -> Gam ab -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gam ab -> Gam ab -> Bool
$c/= :: forall ab. Eq ab => Gam ab -> Gam ab -> Bool
== :: Gam ab -> Gam ab -> Bool
$c== :: forall ab. Eq ab => Gam ab -> Gam ab -> Bool
Eq,Eq (Gam ab)
Eq (Gam ab)
-> (Gam ab -> Gam ab -> Ordering)
-> (Gam ab -> Gam ab -> Bool)
-> (Gam ab -> Gam ab -> Bool)
-> (Gam ab -> Gam ab -> Bool)
-> (Gam ab -> Gam ab -> Bool)
-> (Gam ab -> Gam ab -> Gam ab)
-> (Gam ab -> Gam ab -> Gam ab)
-> Ord (Gam ab)
Gam ab -> Gam ab -> Bool
Gam ab -> Gam ab -> Ordering
Gam ab -> Gam ab -> Gam ab
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 ab. Ord ab => Eq (Gam ab)
forall ab. Ord ab => Gam ab -> Gam ab -> Bool
forall ab. Ord ab => Gam ab -> Gam ab -> Ordering
forall ab. Ord ab => Gam ab -> Gam ab -> Gam ab
min :: Gam ab -> Gam ab -> Gam ab
$cmin :: forall ab. Ord ab => Gam ab -> Gam ab -> Gam ab
max :: Gam ab -> Gam ab -> Gam ab
$cmax :: forall ab. Ord ab => Gam ab -> Gam ab -> Gam ab
>= :: Gam ab -> Gam ab -> Bool
$c>= :: forall ab. Ord ab => Gam ab -> Gam ab -> Bool
> :: Gam ab -> Gam ab -> Bool
$c> :: forall ab. Ord ab => Gam ab -> Gam ab -> Bool
<= :: Gam ab -> Gam ab -> Bool
$c<= :: forall ab. Ord ab => Gam ab -> Gam ab -> Bool
< :: Gam ab -> Gam ab -> Bool
$c< :: forall ab. Ord ab => Gam ab -> Gam ab -> Bool
compare :: Gam ab -> Gam ab -> Ordering
$ccompare :: forall ab. Ord ab => Gam ab -> Gam ab -> Ordering
$cp1Ord :: forall ab. Ord ab => Eq (Gam ab)
Ord,Int -> Gam ab -> ShowS
[Gam ab] -> ShowS
Gam ab -> String
(Int -> Gam ab -> ShowS)
-> (Gam ab -> String) -> ([Gam ab] -> ShowS) -> Show (Gam ab)
forall ab. Show ab => Int -> Gam ab -> ShowS
forall ab. Show ab => [Gam ab] -> ShowS
forall ab. Show ab => Gam ab -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gam ab] -> ShowS
$cshowList :: forall ab. Show ab => [Gam ab] -> ShowS
show :: Gam ab -> String
$cshow :: forall ab. Show ab => Gam ab -> String
showsPrec :: Int -> Gam ab -> ShowS
$cshowsPrec :: forall ab. Show ab => Int -> Gam ab -> ShowS
Show,a -> Gam b -> Gam a
(a -> b) -> Gam a -> Gam b
(forall a b. (a -> b) -> Gam a -> Gam b)
-> (forall a b. a -> Gam b -> Gam a) -> Functor Gam
forall a b. a -> Gam b -> Gam a
forall a b. (a -> b) -> Gam a -> Gam b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Gam b -> Gam a
$c<$ :: forall a b. a -> Gam b -> Gam a
fmap :: (a -> b) -> Gam a -> Gam b
$cfmap :: forall a b. (a -> b) -> Gam a -> Gam b
Functor)

--------------------------------------------------------------------------------

-- | Class of monomial bases which form modules over the @H^*(BGL2)@
class Functor f => Equivariant f where 
  injectMonom  :: x -> f x
  projectMonom :: f x -> x

instance Equivariant Omega where 
  injectMonom :: x -> Omega x
injectMonom = [Int] -> x -> Omega x
forall ab. [Int] -> ab -> Omega ab
Omega [] 
  projectMonom :: Omega x -> x
projectMonom (Omega [Int]
_ x
ab) = x
ab

instance Equivariant Eta where 
  injectMonom :: x -> Eta x
injectMonom = [Int] -> x -> Eta x
forall ab. [Int] -> ab -> Eta ab
Eta [] 
  projectMonom :: Eta x -> x
projectMonom (Eta [Int]
_ x
ab) = x
ab

instance Equivariant Gam where  
  injectMonom :: x -> Gam x
injectMonom = Int -> x -> Gam x
forall ab. Int -> ab -> Gam ab
Gam Int
0  
  projectMonom :: Gam x -> x
projectMonom (Gam Int
_ x
ab) = x
ab

injectZMod :: (Equivariant f, ChernBase base, Ord (f base)) => ZMod base -> ZMod (f base)
injectZMod :: ZMod base -> ZMod (f base)
injectZMod = (base -> f base) -> ZMod base -> ZMod (f base)
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase base -> f base
forall (f :: * -> *) x. Equivariant f => x -> f x
injectMonom

forgetGamma :: Ord base => ZMod (Gam base) -> ZMod base 
forgetGamma :: ZMod (Gam base) -> ZMod base
forgetGamma = (Gam base -> Maybe base) -> ZMod (Gam base) -> ZMod base
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> Maybe b) -> FreeMod c a -> FreeMod c b
ZMod.mapMaybeBase Gam base -> Maybe base
forall a. Gam a -> Maybe a
f where
  f :: Gam a -> Maybe a
f (Gam Int
k a
ab) = case Int
k of
    Int
0 -> a -> Maybe a
forall a. a -> Maybe a
Just a
ab
    Int
_ -> Maybe a
forall a. Maybe a
Nothing

forgetEquiv :: ChernBase base => ZMod (Gam base) -> ZMod G
forgetEquiv :: ZMod (Gam base) -> ZMod G
forgetEquiv = (Gam base -> Maybe G) -> ZMod (Gam base) -> ZMod G
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> Maybe b) -> FreeMod c a -> FreeMod c b
ZMod.mapMaybeBase Gam base -> Maybe G
forall a. (Eq a, Monoid a) => Gam a -> Maybe G
f where
  f :: Gam a -> Maybe G
f (Gam Int
k a
ab) = if (a
ab a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty) 
    then G -> Maybe G
forall a. a -> Maybe a
Just (Int -> G
G Int
k)
    else Maybe G
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- * Conversion between different bases

convertOmega   
  :: (Ord ab, Ord cd)
  => (ZMod ab -> ZMod cd) 
  -> ZMod (Omega ab) -> ZMod (Omega cd)
convertOmega :: (ZMod ab -> ZMod cd) -> ZMod (Omega ab) -> ZMod (Omega cd)
convertOmega = (forall y. Omega y -> [Int])
-> (forall x. Omega x -> x)
-> (forall ab. [Int] -> ab -> Omega ab)
-> (ZMod ab -> ZMod cd)
-> ZMod (Omega ab)
-> ZMod (Omega cd)
forall (f :: * -> *) x y ab cd.
(Functor f, Ord ab, Ord cd, Ord (f ab), Ord (f cd), Ord x) =>
(forall y. f y -> x)
-> (forall y. f y -> y)
-> (forall y. x -> y -> f y)
-> (ZMod ab -> ZMod cd)
-> ZMod (f ab)
-> ZMod (f cd)
convertEach forall y. Omega y -> [Int]
f forall x. Omega x -> x
g forall ab. [Int] -> ab -> Omega ab
Omega where
  f :: Omega ab -> [Int]
f (Omega [Int]
xs ab
_ ) = [Int]
xs
  g :: Omega ab -> ab
g (Omega [Int]
_  ab
ab) = ab
ab

convertEta
  :: (Ord ab, Ord cd)
  => (ZMod ab -> ZMod cd) 
  -> ZMod (Eta ab) -> ZMod (Eta cd)
convertEta :: (ZMod ab -> ZMod cd) -> ZMod (Eta ab) -> ZMod (Eta cd)
convertEta = (forall y. Eta y -> [Int])
-> (forall x. Eta x -> x)
-> (forall ab. [Int] -> ab -> Eta ab)
-> (ZMod ab -> ZMod cd)
-> ZMod (Eta ab)
-> ZMod (Eta cd)
forall (f :: * -> *) x y ab cd.
(Functor f, Ord ab, Ord cd, Ord (f ab), Ord (f cd), Ord x) =>
(forall y. f y -> x)
-> (forall y. f y -> y)
-> (forall y. x -> y -> f y)
-> (ZMod ab -> ZMod cd)
-> ZMod (f ab)
-> ZMod (f cd)
convertEach forall y. Eta y -> [Int]
f forall x. Eta x -> x
g forall ab. [Int] -> ab -> Eta ab
Eta where
  f :: Eta ab -> [Int]
f (Eta [Int]
xs ab
_ ) = [Int]
xs
  g :: Eta ab -> ab
g (Eta [Int]
_  ab
ab) = ab
ab

convertGam
  :: (Ord ab, Ord cd)
  => (ZMod ab -> ZMod cd) 
  -> ZMod (Gam ab) -> ZMod (Gam cd)
convertGam :: (ZMod ab -> ZMod cd) -> ZMod (Gam ab) -> ZMod (Gam cd)
convertGam = (forall y. Gam y -> Int)
-> (forall x. Gam x -> x)
-> (forall ab. Int -> ab -> Gam ab)
-> (ZMod ab -> ZMod cd)
-> ZMod (Gam ab)
-> ZMod (Gam cd)
forall (f :: * -> *) x y ab cd.
(Functor f, Ord ab, Ord cd, Ord (f ab), Ord (f cd), Ord x) =>
(forall y. f y -> x)
-> (forall y. f y -> y)
-> (forall y. x -> y -> f y)
-> (ZMod ab -> ZMod cd)
-> ZMod (f ab)
-> ZMod (f cd)
convertEach forall y. Gam y -> Int
f forall x. Gam x -> x
g forall ab. Int -> ab -> Gam ab
Gam where
  f :: Gam ab -> Int
f (Gam Int
k ab
_ ) = Int
k
  g :: Gam ab -> ab
g (Gam Int
_ ab
ab) = ab
ab

-- | A generic function which can convert the @GL2@ representations
convertEach 
  :: forall f x y ab cd. (Functor f, Ord ab, Ord cd, Ord (f ab), Ord (f cd), Ord x) 
  => (forall y. f y -> x)
  -> (forall y. f y -> y)
  -> (forall y. x -> y -> f y)
  -> (ZMod    ab  -> ZMod    cd )
  ->  ZMod (f ab) -> ZMod (f cd)
convertEach :: (forall y. f y -> x)
-> (forall y. f y -> y)
-> (forall y. x -> y -> f y)
-> (ZMod ab -> ZMod cd)
-> ZMod (f ab)
-> ZMod (f cd)
convertEach forall y. f y -> x
selx forall y. f y -> y
sely forall y. x -> y -> f y
build ZMod ab -> ZMod cd
convert ZMod (f ab)
src = ZMod (f cd)
tgt where
  tgt :: ZMod (f cd)
tgt    = [ZMod (f cd)] -> ZMod (f cd)
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ x -> ZMod (f cd)
worker x
layer | x
layer <- [x]
layers ]
  layers :: [x]
layers = Set x -> [x]
forall a. Set a -> [a]
Set.toList (Set x -> [x]) -> Set x -> [x]
forall a b. (a -> b) -> a -> b
$ (f ab -> x) -> Set (f ab) -> Set x
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map f ab -> x
forall y. f y -> x
selx (Set (f ab) -> Set x) -> Set (f ab) -> Set x
forall a b. (a -> b) -> a -> b
$ Map (f ab) Integer -> Set (f ab)
forall k a. Map k a -> Set k
Map.keysSet (Map (f ab) Integer -> Set (f ab))
-> Map (f ab) Integer -> Set (f ab)
forall a b. (a -> b) -> a -> b
$ ZMod (f ab) -> Map (f ab) Integer
forall coeff base. FreeMod coeff base -> Map base coeff
unFreeMod ZMod (f ab)
src :: [x]
  worker :: x -> ZMod (f cd)
worker x
layer 
    = Map (f cd) Integer -> ZMod (f cd)
forall coeff base. Map base coeff -> FreeMod coeff base
FreeMod
    (Map (f cd) Integer -> ZMod (f cd))
-> Map (f cd) Integer -> ZMod (f cd)
forall a b. (a -> b) -> a -> b
$ (cd -> f cd) -> Map cd Integer -> Map (f cd) Integer
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (x -> cd -> f cd
forall y. x -> y -> f y
build x
layer)
    (Map cd Integer -> Map (f cd) Integer)
-> Map cd Integer -> Map (f cd) Integer
forall a b. (a -> b) -> a -> b
$ ZMod cd -> Map cd Integer
forall coeff base. FreeMod coeff base -> Map base coeff
unFreeMod
    (ZMod cd -> Map cd Integer) -> ZMod cd -> Map cd Integer
forall a b. (a -> b) -> a -> b
$ ZMod ab -> ZMod cd
convert
    (ZMod ab -> ZMod cd) -> ZMod ab -> ZMod cd
forall a b. (a -> b) -> a -> b
$ Map ab Integer -> ZMod ab
forall coeff base. Map base coeff -> FreeMod coeff base
FreeMod
    (Map ab Integer -> ZMod ab) -> Map ab Integer -> ZMod ab
forall a b. (a -> b) -> a -> b
$ (f ab -> ab) -> Map (f ab) Integer -> Map ab Integer
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys f ab -> ab
forall y. f y -> y
sely 
    (Map (f ab) Integer -> Map ab Integer)
-> Map (f ab) Integer -> Map ab Integer
forall a b. (a -> b) -> a -> b
$ (f ab -> Integer -> Bool)
-> Map (f ab) Integer -> Map (f ab) Integer
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\f ab
k Integer
_ -> f ab -> x
forall y. f y -> x
selx f ab
k x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
layer) 
    (Map (f ab) Integer -> Map (f ab) Integer)
-> Map (f ab) Integer -> Map (f ab) Integer
forall a b. (a -> b) -> a -> b
$ ZMod (f ab) -> Map (f ab) Integer
forall coeff base. FreeMod coeff base -> Map base coeff
unFreeMod ZMod (f ab)
src

--------------------------------------------------------------------------------

-- | This is a hack to reuse the same pushforward code
unsafeEtaToOmega :: (Eq coeff, Num coeff, Ord ab) => FreeMod coeff (Eta ab) -> FreeMod coeff (Omega ab)
unsafeEtaToOmega :: FreeMod coeff (Eta ab) -> FreeMod coeff (Omega ab)
unsafeEtaToOmega = (Eta ab -> Omega ab)
-> FreeMod coeff (Eta ab) -> FreeMod coeff (Omega ab)
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase Eta ab -> Omega ab
forall ab. Eta ab -> Omega ab
f where
  f :: Eta ab -> Omega ab
f (Eta [Int]
js ab
ab) = [Int] -> ab -> Omega ab
forall ab. [Int] -> ab -> Omega ab
Omega [Int]
js ab
ab

unsafeOmegaToEta :: (Eq coeff, Num coeff, Ord ab) => FreeMod coeff (Omega ab) -> FreeMod coeff (Eta ab)
unsafeOmegaToEta :: FreeMod coeff (Omega ab) -> FreeMod coeff (Eta ab)
unsafeOmegaToEta = (Omega ab -> Eta ab)
-> FreeMod coeff (Omega ab) -> FreeMod coeff (Eta ab)
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase Omega ab -> Eta ab
forall ab. Omega ab -> Eta ab
f where
  f :: Omega ab -> Eta ab
f (Omega [Int]
js ab
ab) = [Int] -> ab -> Eta ab
forall ab. [Int] -> ab -> Eta ab
Eta [Int]
js ab
ab

--------------------------------------------------------------------------------

#if MIN_VERSION_base(4,11,0)     

instance Semigroup ab => Semigroup (Omega ab) where
  (Omega [Int]
as ab
ab1) <> :: Omega ab -> Omega ab -> Omega ab
<> (Omega [Int]
bs ab
ab2) = 
    if [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub [Int]
cs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
cs
      then [Int] -> ab -> Omega ab
forall ab. [Int] -> ab -> Omega ab
Omega [Int]
cs (ab
ab1 ab -> ab -> ab
forall a. Semigroup a => a -> a -> a
<> ab
ab2)
      else String -> Omega ab
forall a. HasCallStack => String -> a
error String
"Omega/monoid: duplicate indices"
    where
      cs :: [Int]
cs = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int]
as [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
bs)

instance Semigroup ab => Semigroup (Eta ab) where
  (Eta [Int]
fs ab
ab1) <> :: Eta ab -> Eta ab -> Eta ab
<> (Eta [Int]
gs ab
ab2) = 
    if [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub [Int]
hs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
hs
      then [Int] -> ab -> Eta ab
forall ab. [Int] -> ab -> Eta ab
Eta [Int]
hs (ab
ab1 ab -> ab -> ab
forall a. Semigroup a => a -> a -> a
<> ab
ab2)
      else String -> Eta ab
forall a. HasCallStack => String -> a
error String
"Eta/monoid: duplicate indices"
    where
      hs :: [Int]
hs = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int]
fs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
gs)

instance Semigroup ab => Semigroup (Gam ab) where
  (Gam Int
e ab
ab1) <> :: Gam ab -> Gam ab -> Gam ab
<> (Gam Int
f ab
ab2) = Int -> ab -> Gam ab
forall ab. Int -> ab -> Gam ab
Gam (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
f) (ab
ab1 ab -> ab -> ab
forall a. Semigroup a => a -> a -> a
<> ab
ab2)

instance Monoid ab => Monoid (Omega ab) where
  mempty :: Omega ab
mempty = [Int] -> ab -> Omega ab
forall ab. [Int] -> ab -> Omega ab
Omega [] ab
forall a. Monoid a => a
mempty

instance Monoid ab => Monoid (Eta ab) where
  mempty :: Eta ab
mempty = [Int] -> ab -> Eta ab
forall ab. [Int] -> ab -> Eta ab
Eta [] ab
forall a. Monoid a => a
mempty

instance Monoid ab => Monoid (Gam ab) where
  mempty :: Gam ab
mempty = Int -> ab -> Gam ab
forall ab. Int -> ab -> Gam ab
Gam Int
0 ab
forall a. Monoid a => a
mempty

#else

instance Monoid ab => Monoid (Omega ab) where
  mempty = Omega [] mempty
  (Omega as ab1) `mappend` (Omega bs ab2) = 
    if nub cs == cs
      then Omega cs (ab1 <> ab2)
      else error "Omega/monoid: duplicate indices"
    where
      cs = sort (as ++ bs)

instance Monoid ab => Monoid (Eta ab) where
  mempty = Eta [] mempty
  (Eta fs ab1) `mappend` (Eta gs ab2) = 
    if nub hs == hs
      then Eta hs (ab1 <> ab2)
      else error "Eta/monoid: duplicate indices"
    where
      hs = sort (fs ++ gs)

instance Monoid ab => Monoid (Gam ab) where
  mempty = Gam 0 mempty
  (Gam e ab1) `mappend` (Gam f ab2) = Gam (e+f) (ab1 <> ab2)

#endif

--------------------------------------------------------------------------------

instance (Pretty ab, Monoid ab, Eq ab) => Pretty (Gam ab) where
  pretty :: Gam ab -> String
pretty (Gam Int
0 ab
ab) = ab -> String
forall a. Pretty a => a -> String
pretty ab
ab
  pretty (Gam Int
g ab
ab)
    | ab
ab ab -> ab -> Bool
forall a. Eq a => a -> a -> Bool
== ab
forall a. Monoid a => a
mempty  = String
"g^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
g
    | Bool
otherwise     = String
"g^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ab -> String
forall a. Pretty a => a -> String
pretty ab
ab

instance (Pretty ab, Monoid ab, Eq ab) => Pretty (Eta ab) where
  pretty :: Eta ab -> String
pretty Eta ab
eta = 
    case Eta ab
eta of
      (Eta [] ab
ab)       -> ab -> String
forall a. Pretty a => a -> String
pretty ab
ab 
      (Eta [Int]
is ab
ab)   
        | ab
ab ab -> ab -> Bool
forall a. Eq a => a -> a -> Bool
== ab
forall a. Monoid a => a
mempty  -> [Int] -> String
forall a. Show a => [a] -> String
hs [Int]
is
        | Bool
otherwise     -> [Int] -> String
forall a. Show a => [a] -> String
hs [Int]
is String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ab -> String
forall a. Pretty a => a -> String
pretty ab
ab 
    where
      hs :: [a] -> String
hs [a]
is = case [a]
is of
        [] -> String
""
        [a]
_  -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" [ String
"h" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i | a
i<-[a]
is ]

instance (Pretty ab, Monoid ab, Eq ab) => Pretty (Omega ab) where
  pretty :: Omega ab -> String
pretty Omega ab
omega = 
    case Omega ab
omega of
      (Omega [] ab
ab)       -> ab -> String
forall a. Pretty a => a -> String
pretty ab
ab 
      (Omega [Int]
is ab
ab)    
        | ab
ab ab -> ab -> Bool
forall a. Eq a => a -> a -> Bool
== ab
forall a. Monoid a => a
mempty    -> [Int] -> String
forall a. Show a => [a] -> String
us [Int]
is
        | Bool
otherwise       -> [Int] -> String
forall a. Show a => [a] -> String
us [Int]
is String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ab -> String
forall a. Pretty a => a -> String
pretty ab
ab 
    where
      us :: [a] -> String
us [a]
is = case [a]
is of
        [] -> String
""
        [a]
_  -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"*" [ String
"u" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i | a
i<-[a]
is ]

--------------------------------------------------------------------------------