{-|
Module      : Internal.FormattingData
Description : Defines data structures and functions relating to the placement
              of functors on a TikZ canvas
Copyright   : Anthony Wang, 2021
License     : MIT
Maintainer  : anthony.y.wang.math@gmail.com

@Internal.FormattingData@ defines data structures relating to the placement
    of functors on a TikZ canvas when drawing a string diagram.
-}
module Internal.FormattingData where

import Prelude hiding (Functor)
import Data.Array (Array, array, range)
import Data.List (intercalate, zipWith5, inits)
import Data.Maybe (catMaybes)
import Internal.TwoCatOfCats
import TikzObjects

-- | 'FunctorFormatting' is a data structure that specifies the spacing
-- for a composite of basic functors on a horizontal line.
--
-- The @ff_length@ is the total length of the line.
-- The @ff_positions_list@ is the collection of indices where a functor is placed.
-- The @ff_positions_list@ is indexed starting at 0.
--
-- For example, if we use @(FunctorFormatting 5 [1,2,4])@ to 
--  format a composition F G H (composing from left to right as is our convention),
--  we would get the spacing
--
--      & F & G & & H,
--
--  while using @(FunctorFormatting 4 [0,1,3])@ to format the same list would give the spacing
--
--      F & G & & H.
--
-- The notation for the spacing above is similar to how spacing is defined in LaTeX, i.e. in
-- tables, arrays, etc.
--
-- Assumptions on the data: @ff_positions_list@ is an increasing list of nonnegative integers.
-- The largest element in @ff_positions_list@, if it exists, is at most @ff_length - 1@.
data FunctorFormatting = FunctorFormatting
    { FunctorFormatting -> Int
ff_length   :: !Int
    , FunctorFormatting -> [Int]
ff_positions_list :: ![Int]
    } deriving (FunctorFormatting -> FunctorFormatting -> Bool
(FunctorFormatting -> FunctorFormatting -> Bool)
-> (FunctorFormatting -> FunctorFormatting -> Bool)
-> Eq FunctorFormatting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctorFormatting -> FunctorFormatting -> Bool
$c/= :: FunctorFormatting -> FunctorFormatting -> Bool
== :: FunctorFormatting -> FunctorFormatting -> Bool
$c== :: FunctorFormatting -> FunctorFormatting -> Bool
Eq)
    
-- | 'ff_num_positions' of a @FunctorFormatting@ is equal to the @func_reduced_length@
-- of a functor which it can format, i.e. it is the length of @func_positions_list@.
ff_num_positions :: FunctorFormatting -> Int
ff_num_positions :: FunctorFormatting -> Int
ff_num_positions = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int)
-> (FunctorFormatting -> [Int]) -> FunctorFormatting -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctorFormatting -> [Int]
ff_positions_list

-- | Data of type 'FunctorFormatting' naturally form an operad, with each @FunctorFormatting@
-- giving an n-ary operation where n is equal to the number of positions given by
-- @ff_num_positions@.
--
-- If @ff@ is a @FunctorFormatting@ with n=@(ff_num_positions ff)@, and
-- @[ff1, ..., ffn]@ is a list of n @FunctorFormatting@s, then
-- we can get a composite @FunctorFormatting@ by putting @ff1@ at the first position
-- in @ff@,..., and @ffn@ at the nth position in @ff@.
--
-- For example:
--
-- If @ff@ is the formatting @"*&*&*&*"@
-- and @ff1@,...,@ff4@ are all @empty@, then @ff_operad_compose ff [ff1,ff2,ff3,ff4]@
-- is @empty@.
--
-- If @ff@ is the formatting represented by @"*& &*& "@, @ff1@ is the formatting @"*& &*"@ and
-- @ff2@ is the formatting @"*&*&*& "@, then
-- @ff_operad_compose ff [ff1,ff2]@ is @"*& &*& &*&*&*& & "@.
--
-- @(ff_operad_compose ff ffs)@ is equal to @Nothing@ if the length of @ffs@ is not equal to 
-- @(ff_num_positions ff)@.
-- Otherwise, it returns @Just@ the above composition.
ff_operad_compose :: FunctorFormatting -> [FunctorFormatting] -> Maybe FunctorFormatting
ff_operad_compose :: FunctorFormatting -> [FunctorFormatting] -> Maybe FunctorFormatting
ff_operad_compose FunctorFormatting
ff [FunctorFormatting]
ffs
    | FunctorFormatting -> Int
ff_num_positions FunctorFormatting
ff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [FunctorFormatting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctorFormatting]
ffs = Maybe FunctorFormatting
forall a. Maybe a
Nothing
    | Bool
otherwise                         = FunctorFormatting -> Maybe FunctorFormatting
forall a. a -> Maybe a
Just (Int -> [Int] -> FunctorFormatting
FunctorFormatting Int
new_length [Int]
new_positions_list)
    where 
        new_length :: Int
new_length = (FunctorFormatting -> Int
ff_length FunctorFormatting
ff) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (FunctorFormatting -> Int) -> [FunctorFormatting] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FunctorFormatting -> Int
ff_length [FunctorFormatting]
ffs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (FunctorFormatting -> Int
ff_num_positions FunctorFormatting
ff)
        positions_builder :: [Int] -> Int -> [Int] -> [FunctorFormatting] -> [Int]
        positions_builder :: [Int] -> Int -> [Int] -> [FunctorFormatting] -> [Int]
positions_builder [Int]
current Int
_ [] [] = [Int]
current
        positions_builder [Int]
current Int
offset (Int
n:[Int]
ns) (FunctorFormatting
nf:[FunctorFormatting]
nfs) = 
            [Int] -> Int -> [Int] -> [FunctorFormatting] -> [Int]
positions_builder ([Int]
current [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) (FunctorFormatting -> [Int]
ff_positions_list FunctorFormatting
nf))) 
                              (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (FunctorFormatting -> Int
ff_length FunctorFormatting
nf) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) 
                              [Int]
ns 
                              [FunctorFormatting]
nfs
        positions_builder [Int]
_ Int
_ [Int]
_ [FunctorFormatting]
_ = [Char] -> [Int]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Int]) -> [Char] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Char]
"positions_builder a b c d should only ever be called"
                                              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" when the lengths of c and d are the same."
        new_positions_list :: [Int]
new_positions_list = [Int] -> Int -> [Int] -> [FunctorFormatting] -> [Int]
positions_builder [] Int
0 (FunctorFormatting -> [Int]
ff_positions_list FunctorFormatting
ff) [FunctorFormatting]
ffs


-- | If @f@ is a @Functor@ with @func_reduced_length f@ equal to n,
-- then @default_ff f@ is the formatting @"*&*&...&*"@  where there are n total positions.
default_ff :: Functor -> FunctorFormatting
default_ff :: Functor -> FunctorFormatting
default_ff Functor
func = let n :: Int
n = Functor -> Int
func_reduced_length Functor
func
                  in Int -> [Int] -> FunctorFormatting
FunctorFormatting Int
n [Int
0..(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]

-- | A show function which is easier to understand than the default one.
--
-- If the @FunctorFormatting@ does not satisfy the assumptions above,
-- then it shows @"InvalidFunctorFormatting "++(show ff_length)++" "++(show ff_positions_list)@.
--
-- If the @FunctorFormatting@ has @ff_length@ equal to @0@, then it shows @"empty"@.
-- Otherwise it is a @'&'@ separated list with @ff_length@ number of positions,
--     with a @'*'@ in the positions in @ff_positions_list@ and a @' '@
--     in the other positions.
--
-- For example @show (FunctorFormatting 5 [1,2,4])@ is equal to @" &*&*& &*"@.
instance Show FunctorFormatting where
    show :: FunctorFormatting -> [Char]
show FunctorFormatting
ff 
        | Int
lenInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 Bool -> Bool -> Bool
&& Bool
positions_check 
            = [Char]
"empty"
        | Int
lenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Bool
positions_check  
            = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"&" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int] -> [[Char]]
show_helper (FunctorFormatting -> Int
ff_length FunctorFormatting
ff) Int
0 (FunctorFormatting -> [Int]
ff_positions_list FunctorFormatting
ff)
        | Bool
otherwise                 
            = [Char]
"InvalidFunctorFormatting "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++([Int] -> [Char]
forall a. Show a => a -> [Char]
show [Int]
pos)
        where 
            len :: Int
len = FunctorFormatting -> Int
ff_length FunctorFormatting
ff
            pos :: [Int]
pos = FunctorFormatting -> [Int]
ff_positions_list FunctorFormatting
ff
            in_range :: a -> a -> a -> Bool
in_range a
a a
b a
c = a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
b Bool -> Bool -> Bool
&& a
ba -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
c
            positions_check :: Bool
positions_check = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Bool -> Bool -> Bool
(&&) Bool
True ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int -> Bool) -> [Int] -> [Int] -> [Int] -> [Bool]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
in_range (-Int
1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
pos) [Int]
pos (Int -> [Int]
forall a. a -> [a]
repeat Int
len)
            show_helper :: Int -> Int  -> [Int] -> [String]
            show_helper :: Int -> Int -> [Int] -> [[Char]]
show_helper Int
l Int
posit [] = Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
posit) [Char]
" "
            show_helper Int
l Int
posit (Int
r:[Int]
rs)
                | Int
posit Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l  = []
                | Int
posit Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r  = [Char]
"*"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:(Int -> Int -> [Int] -> [[Char]]
show_helper Int
l (Int
positInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
rs)
                | Bool
otherwise = [Char]
" "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:(Int -> Int -> [Int] -> [[Char]]
show_helper Int
l (Int
positInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
rInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
rs))

-- | A data structure to specify the location of functors when creating a string diagram
-- from a natural transformation.
--
-- We will not attempt to format every possible @NaturalTransformation@, 
--     but will only format a certain subcollection.
-- Roughly speaking, we can format natural transformations that can be thought of as vertical
--     compositions of horizontal compositions of basic natural transformations.
--
-- We will only format the following types of @NaturalTransformation@
--
-- 1. @(NaturalTransformation n d s b o)@ can be formatted with a length 2 list @[ff1, ff2]@
--        of @FunctorFormatting@ where
--     @(ff_num_positions ff1)@ is equal to @func_reduced_length@ of the source functor,
--     @(ff_num_positions ff2)@ is equal to @func_reduced_length@ of the target functor,
--     and at least one of @(ff_num_positions ff1)@ or @(ff_num_positions ff2)@ is nonzero.
--
-- 2. Identity natural transformations of an identity functor of a category @c@,
--      i.e. @(NatTransVerticalComposite (OneGlobelet (CompositeFunctor (ZeroGlobelet c c) []) 
--      (CompositeFunctor (ZeroGlobelet c c) [])) [])@
--      can be formatted with a length 2 list @[ff1,ff2]@ of FunctorFormatting with
--      @(ff_num_positions ff1)@ and @(ff_num_positions ff2)@ both equal to 0
--
-- 3. Identity natural transformations of a functor
--      i.e. @(NatTransVerticalComposite (OneGlobelet (Functor i d b o) (Functor i d b o)) [])@
--      can be formatted with a length 2 list @[ff1,ff2]@ of FunctorFormatting with
--      @(ff_num_positions ff1)@ and @(ff_num_positions ff2)@ both equal to 1
--
-- 4. Horizontal composites of natural transformations of type 1,2,3 above
--      i.e. @(NatTransHorizontalComposite g list)@ where list is a list of natural transformations
--      of types 1,2,3 above, can be formatted with a length 2 list @[ff1, ff2]@
--      of FunctorFormatting, where
--      @ff_num_positions ff1@ is equal to @func_reduced_length@ of the source functor,
--      and @ff_num_positions ff2@ is equal to @func_reduced_length@ of the target functor.
--
-- 5. Vertical composites of natural transformations of type 1,2,3,4,
--      i.e. @(NatTransVerticalComposite g list)@ where list is a nonempty list of natural transformations of
--      types 1,2,3,4 above, can be formatted with a length @l+1@ list @[ff_0, ... , ff_l]@ of 
--      @FunctorFormatting@, where @l@ is the length of @list@,
--      where @ff_num_positions@ of @ff_i@ is equal to 
--      @func_reduced_length@ of the source of @list!!i@ or the @func_reduced_length@
--      of the target of @list!!(i-1)@, whichever is defined
--      (these two are equal when both are defined by our assumptions on @NatTransVerticalComposite@).
type NatFormatting = [FunctorFormatting] 

-- | 'nf_max_horz_position' of a 'NatFormatting' gives the largest @ff_num_positions@
--  among the 'FunctorFormatting' in the list.
nf_max_horz_position :: NatFormatting -> Int
nf_max_horz_position :: [FunctorFormatting] -> Int
nf_max_horz_position [FunctorFormatting]
ffs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (FunctorFormatting -> Int) -> [FunctorFormatting] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FunctorFormatting -> Int
ff_num_positions [FunctorFormatting]
ffs

-- | 'nf_pos_to_coord' takes a 'NatFormatting' @nt@ and a pair @(x,y)@ representing
-- the position of a basic natural transformation in a natural transformation
-- which can be formatted by @nt@, and returns @Just@ the associated coordinate on a TikZ canvas,
--  if possible.
-- It returns @Nothing@ if @(x,y)@ does not specify a valid position in a natural transformation
--  which can be formatted by @nt@.
--
-- Here, @x@ represents the row and @y@ represents the position in the row, with indexing starting
-- at @0@.
-- 'nf_pos_to_coord' will return @Nothing@ unless the following are satisfied:
--
-- -@x@ is between @0@ and @(length nf)-1@, inclusive
-- -@y@ is between @0@ and @(ff_num_positions (nf!!x))-1@, inclusive.
nf_pos_to_coord :: NatFormatting -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord :: [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
x,Int
y)
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                           = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [FunctorFormatting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctorFormatting]
nf                  = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                           = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= FunctorFormatting -> Int
ff_num_positions ([FunctorFormatting]
nf [FunctorFormatting] -> Int -> FunctorFormatting
forall a. [a] -> Int -> a
!! Int
x) = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Bool
otherwise                       = (Float, Float) -> Maybe (Float, Float)
forall a. a -> Maybe a
Just (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((FunctorFormatting -> [Int]
ff_positions_list ([FunctorFormatting]
nf[FunctorFormatting] -> Int -> FunctorFormatting
forall a. [a] -> Int -> a
!!Int
x))[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!Int
y) 
                                             , Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x))

-- | 'nf_pos_to_tikz_coord' returns @Just@ the TikZ coordinate path
-- operation at 'nf_pos_to_coord', with the coordinate named by
-- 'pos_to_internal_name'.
-- It returns @Nothing@ if 'nf_pos_to_coord' returns @Nothing@.
nf_pos_to_tikz_coord :: NatFormatting -> (Int,Int) -> Maybe TikzPathOperation
nf_pos_to_tikz_coord :: [FunctorFormatting] -> (Int, Int) -> Maybe TikzPathOperation
nf_pos_to_tikz_coord [FunctorFormatting]
nf (Int
x,Int
y) 
    = do (Float
a,Float
b) <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
x,Int
y)
         TikzPathOperation -> Maybe TikzPathOperation
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Char] -> TikzCoordinate -> TikzPathOperation
PathOpCoordinate [Char]
"" ((Int, Int) -> [Char]
pos_to_internal_name (Int
x,Int
y)) (Float -> Float -> TikzCoordinate
Canvas Float
a Float
b))

-- | 'pos_to_internal_name' converts a position @(x,y)@ described by the documentation
-- for 'nf_pos_to_coord' and converts it into a @String@ for referencing purposes inside a TikZ
-- picture.
pos_to_internal_name :: (Int, Int) -> String
pos_to_internal_name :: (Int, Int) -> [Char]
pos_to_internal_name (Int
x,Int
y) = [Char]
"tikzsd_internal_pos_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
y)

-- | 'pos_to_named_coord' gives the named @TikzCoordinate@ with name given by
-- 'pos_to_internal_name'.
-- This named coordinate can be used to refer to the @TikzPathOp@
--  coordinate given by 'nf_pos_to_coord'.
pos_to_named_coord :: (Int,Int) -> TikzCoordinate
pos_to_named_coord :: (Int, Int) -> TikzCoordinate
pos_to_named_coord (Int
x,Int
y) = [Char] -> TikzCoordinate
NamedCoordinate ([Char] -> TikzCoordinate) -> [Char] -> TikzCoordinate
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Char]
pos_to_internal_name (Int
x,Int
y)

-- | 'array_of_tikz_coords' takes a 'NatFormatting' @nf@ and returns the array
-- which maps @(x,y)@ to @nf_pos_to_tikz_coord nf (x,y)@.
-- The bounds of the array are from @(0,0)@ to @((length nf)-1,(nf_max_horz_position nf)-1)@.
array_of_tikz_coords :: NatFormatting -> Array (Int, Int) (Maybe TikzPathOperation)
array_of_tikz_coords :: [FunctorFormatting] -> Array (Int, Int) (Maybe TikzPathOperation)
array_of_tikz_coords [FunctorFormatting]
ffs = ((Int, Int), (Int, Int))
-> [((Int, Int), Maybe TikzPathOperation)]
-> Array (Int, Int) (Maybe TikzPathOperation)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int, Int), (Int, Int))
r [((Int, Int)
i, [FunctorFormatting] -> (Int, Int) -> Maybe TikzPathOperation
nf_pos_to_tikz_coord [FunctorFormatting]
ffs (Int, Int)
i) | (Int, Int)
i <- [(Int, Int)]
inds]
    where
        r :: ((Int, Int), (Int, Int))
r = ((Int
0,Int
0), (([FunctorFormatting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctorFormatting]
ffs)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, ([FunctorFormatting] -> Int
nf_max_horz_position [FunctorFormatting]
ffs)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
        inds :: [(Int, Int)]
inds = ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int, Int), (Int, Int))
r

-- | @(get_nt_in_pos nt (x,y))@ will return @Just@ the @y@th basic natural transformation 
--  in the @x@th row.
-- It returns @Nothing@ if @x@ does not specify a row of the natural transformation or  @y<0@ or @y>=@ the number of
--  basic natural transformations in the @x@th row.
-- We assume @nt@ is assumed to be one of the 5 types of natural transformations which we can format,
--  described in the documentation for 'NatFormatting'.
-- It makes sense to think of such @nt@ as vertical composites of horizontal composites of natural
-- transformations.
-- @x@ specifies the index in the vertical composite, while @y@ specifies the index in the
-- horizontal composite, with indexing starting at @0@.
get_nt_in_pos :: NaturalTransformation -> (Int, Int) -> Maybe NaturalTransformation
get_nt_in_pos :: NaturalTransformation -> (Int, Int) -> Maybe NaturalTransformation
get_nt_in_pos (NaturalTransformation [Char]
n [Char]
d [Char]
s OneGlobelet
b [Char]
o)  (Int
x,Int
y)
    | Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0  = Maybe NaturalTransformation
forall a. Maybe a
Nothing
    | Bool
otherwise     = NaturalTransformation -> Maybe NaturalTransformation
forall a. a -> Maybe a
Just ([Char]
-> [Char]
-> [Char]
-> OneGlobelet
-> [Char]
-> NaturalTransformation
NaturalTransformation [Char]
n [Char]
d [Char]
s OneGlobelet
b [Char]
o)
get_nt_in_pos (NatTransVerticalComposite (OneGlobelet (CompositeFunctor ZeroGlobelet
_ []) (CompositeFunctor ZeroGlobelet
_ [])) []) (Int, Int)
_ 
    = Maybe NaturalTransformation
forall a. Maybe a
Nothing
get_nt_in_pos (NatTransVerticalComposite (OneGlobelet (Functor [Char]
_ [Char]
_ ZeroGlobelet
_ [Char]
_) Functor
_ ) []) (Int, Int)
_ 
    = Maybe NaturalTransformation
forall a. Maybe a
Nothing
get_nt_in_pos (NatTransHorizontalComposite OneGlobelet
_bg [NaturalTransformation]
nts) (Int
x,Int
y)
    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NaturalTransformation]
simple_nts = Maybe NaturalTransformation
forall a. Maybe a
Nothing
    | Bool
otherwise                               = NaturalTransformation -> Maybe NaturalTransformation
forall a. a -> Maybe a
Just ([NaturalTransformation]
simple_nts[NaturalTransformation] -> Int -> NaturalTransformation
forall a. [a] -> Int -> a
!!Int
y)
    where
        simple_nts :: [NaturalTransformation]
simple_nts = (NaturalTransformation -> Bool)
-> [NaturalTransformation] -> [NaturalTransformation]
forall a. (a -> Bool) -> [a] -> [a]
filter NaturalTransformation -> Bool
is_basic_nt [NaturalTransformation]
nts
get_nt_in_pos (NatTransVerticalComposite OneGlobelet
_bg [NaturalTransformation]
nts) (Int
x,Int
y)
    | Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NaturalTransformation]
nts = Maybe NaturalTransformation
forall a. Maybe a
Nothing
    | Bool
otherwise              = NaturalTransformation -> (Int, Int) -> Maybe NaturalTransformation
get_nt_in_pos ([NaturalTransformation]
nts[NaturalTransformation] -> Int -> NaturalTransformation
forall a. [a] -> Int -> a
!!Int
x) (Int
0,Int
y)

-- | @(get_nt_pos_to_coord nt nf (x,y))@ will calculate the TikZ coordinates the basic natural
--  tranformation @(get_nt_in_pos nt (x,y))@ should be placed at.
-- It returns
--      @Just@ the coordinates if @(get_nt_in_pos nt (x,y)@ is not @Nothing@,
--      and @Nothing@ otherwise.
-- @nt@ is assumed to be one of the natural transformations we can format,
--  and @nf@ is assumed to be a 'NatFormatting' which can be used to format @nt@.
-- The TikZ coordinates of the basic natural transformation @(get_nt_in_pos nt (x,y))@
-- is based on the TikZ coordinates of the basic functors in its source and target.
nt_nf_pos_to_coord :: NaturalTransformation -> NatFormatting -> (Int, Int) -> Maybe (Float, Float)
nt_nf_pos_to_coord :: NaturalTransformation
-> [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nt_nf_pos_to_coord (NaturalTransformation [Char]
_n [Char]
_d [Char]
_s OneGlobelet
b [Char]
_o) [FunctorFormatting]
nf (Int
x,Int
y)
    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Int
target_len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = do (Float, Float)
sf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0,Int
0)
                            (Float, Float)
sl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0, Int
source_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                            (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0.5Float -> Float -> Float
forall a. Num a => a -> a -> a
*(((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sl)),-Float
1) 
    | Int
source_len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = do (Float, Float)
tf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1,Int
0)
                            (Float, Float)
tl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1, Int
target_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                            (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0.5Float -> Float -> Float
forall a. Num a => a -> a -> a
*(((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tl)),-Float
1)
    | Bool
otherwise        = do (Float, Float)
sf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0,Int
0)
                            (Float, Float)
sl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0,Int
source_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                            (Float, Float)
tf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1,Int
0)
                            (Float, Float)
tl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1, Int
target_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                            (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0.25Float -> Float -> Float
forall a. Num a => a -> a -> a
*(((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sl)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tl)),-Float
1)
    where 
        source_len :: Int
source_len = Functor -> Int
func_reduced_length (Functor -> Int) -> Functor -> Int
forall a b. (a -> b) -> a -> b
$ OneGlobelet -> Functor
glob1_source OneGlobelet
b
        target_len :: Int
target_len = Functor -> Int
func_reduced_length (Functor -> Int) -> Functor -> Int
forall a b. (a -> b) -> a -> b
$ OneGlobelet -> Functor
glob1_target OneGlobelet
b
nt_nf_pos_to_coord (NatTransVerticalComposite (OneGlobelet (CompositeFunctor ZeroGlobelet
_ []) (CompositeFunctor ZeroGlobelet
_ [])) []) [FunctorFormatting]
_nf (Int
_x,Int
_y) 
    = Maybe (Float, Float)
forall a. Maybe a
Nothing
nt_nf_pos_to_coord (NatTransVerticalComposite (OneGlobelet (Functor [Char]
_ [Char]
_ ZeroGlobelet
_ [Char]
_) Functor
_ ) []) [FunctorFormatting]
_nf (Int
_x,Int
_y) = Maybe (Float, Float)
forall a. Maybe a
Nothing
nt_nf_pos_to_coord (NatTransHorizontalComposite OneGlobelet
_bg [NaturalTransformation]
nts) [FunctorFormatting]
nf (Int
x,Int
y)
    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NaturalTransformation]
nts = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Int
target_len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0                   = do (Float, Float)
sf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0,Int
source_offset)
                                             (Float, Float)
sl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0, Int
source_offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
source_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                             (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0.5Float -> Float -> Float
forall a. Num a => a -> a -> a
*(((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sl)),-Float
1)
    | Int
source_len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0                   = do (Float, Float)
tf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1,Int
target_offset)
                                             (Float, Float)
tl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1,Int
target_offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
target_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                             (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0.5Float -> Float -> Float
forall a. Num a => a -> a -> a
*(((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tl)),-Float
1)
    | Bool
otherwise                         = do (Float, Float)
sf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0,Int
source_offset)
                                             (Float, Float)
sl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
0,Int
source_offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
source_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                             (Float, Float)
tf <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1,Int
target_offset)
                                             (Float, Float)
tl <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
1,Int
target_offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
target_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                             (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0.25Float -> Float -> Float
forall a. Num a => a -> a -> a
*(((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sl)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tf)Float -> Float -> Float
forall a. Num a => a -> a -> a
+((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
tl)),-Float
1)
    where 
        num_taken :: [NaturalTransformation] -> Int -> Int
        --num_taken ns m gives the position in ns of the mth basic natural transformation, i.e. of the form
        --  (NaturalTransformation n d s b o). 
        --  Here 1 is the first position and (length ns)+1 means there are less than m natural
        --  transformations of the form (NaturalTransformation n d s b o) in ns
        -- We assume that m>=1
        num_taken :: [NaturalTransformation] -> Int -> Int
num_taken [] Int
_ = Int
1
        num_taken ((NaturalTransformation [Char]
_ [Char]
_ [Char]
_ OneGlobelet
_ [Char]
_):[NaturalTransformation]
_) Int
1 = Int
1
        num_taken ((NaturalTransformation [Char]
_ [Char]
_ [Char]
_ OneGlobelet
_ [Char]
_):[NaturalTransformation]
ns) Int
m = Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+([NaturalTransformation] -> Int -> Int
num_taken [NaturalTransformation]
ns (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
        num_taken (NaturalTransformation
_:[NaturalTransformation]
ns) Int
m = Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+([NaturalTransformation] -> Int -> Int
num_taken [NaturalTransformation]
ns Int
m)
        z :: Int
z = [NaturalTransformation] -> Int -> Int
num_taken [NaturalTransformation]
nts (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        beg_nts :: [NaturalTransformation]
beg_nts = Int -> [NaturalTransformation] -> [NaturalTransformation]
forall a. Int -> [a] -> [a]
take (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [NaturalTransformation]
nts --because of how we guarded, this should not be evaluated if z>length nts
        current_nt :: NaturalTransformation
current_nt = [NaturalTransformation]
nts [NaturalTransformation] -> Int -> NaturalTransformation
forall a. [a] -> Int -> a
!! (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        source_len :: Int
source_len = NaturalTransformation -> Int
nat_source_length NaturalTransformation
current_nt
        target_len :: Int
target_len = NaturalTransformation -> Int
nat_target_length NaturalTransformation
current_nt
        source_offset :: Int
source_offset = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Int) -> [NaturalTransformation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NaturalTransformation -> Int
nat_source_length [NaturalTransformation]
beg_nts
        target_offset :: Int
target_offset = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Int) -> [NaturalTransformation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NaturalTransformation -> Int
nat_target_length [NaturalTransformation]
beg_nts
nt_nf_pos_to_coord (NatTransVerticalComposite OneGlobelet
_bg [NaturalTransformation]
nts) [FunctorFormatting]
nf (Int
x,Int
y) 
    | Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NaturalTransformation]
nts = Maybe (Float, Float)
forall a. Maybe a
Nothing
    | Bool
otherwise             = do (Float
a,Float
_) <- NaturalTransformation
-> [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nt_nf_pos_to_coord ([NaturalTransformation]
nts[NaturalTransformation] -> Int -> NaturalTransformation
forall a. [a] -> Int -> a
!!Int
x) (Int -> [FunctorFormatting] -> [FunctorFormatting]
forall a. Int -> [a] -> [a]
drop Int
x [FunctorFormatting]
nf) (Int
0,Int
y)
                                 (Float, Float) -> Maybe (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
a,Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- | 'nt_nf_pos_to_nt_node' gives @Just@ the TikZ node path operation with a node created at
-- 'nt_nf_pos_to_coord' with name given by 'nt_pos_to_internal_name'.
-- It returns @Nothing@ if 'nt_nf_pos_to_coord' returns @Nothing@.
nt_nf_pos_to_nt_node :: NaturalTransformation -> NatFormatting -> (Int,Int) -> Maybe TikzPathOperation
nt_nf_pos_to_nt_node :: NaturalTransformation
-> [FunctorFormatting] -> (Int, Int) -> Maybe TikzPathOperation
nt_nf_pos_to_nt_node NaturalTransformation
nt [FunctorFormatting]
nf (Int
x,Int
y) = do NaturalTransformation
basic_nt <- NaturalTransformation -> (Int, Int) -> Maybe NaturalTransformation
get_nt_in_pos NaturalTransformation
nt (Int
x,Int
y)
                                      (Float
a,Float
b) <- NaturalTransformation
-> [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nt_nf_pos_to_coord NaturalTransformation
nt [FunctorFormatting]
nf (Int
x,Int
y)
                                      let opts :: [Char]
opts = NaturalTransformation -> [Char]
nt_options NaturalTransformation
basic_nt
                                      let shape :: [Char]
shape = NaturalTransformation -> [Char]
nt_shapeString NaturalTransformation
basic_nt
                                      let disp :: [Char]
disp = NaturalTransformation -> [Char]
nt_displayString NaturalTransformation
basic_nt
                                      let name :: [Char]
name = (Int, Int) -> [Char]
nt_pos_to_internal_name (Int
x,Int
y)
                                      TikzPathOperation -> Maybe TikzPathOperation
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Char] -> TikzCoordinate -> [Char] -> TikzPathOperation
PathOpNode ([Char]
shape[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
",draw,"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
opts) [Char]
name (Float -> Float -> TikzCoordinate
Canvas Float
a Float
b) [Char]
disp)

-- | 'nt_pos_to_internal_name' converts a position @(x,y)@ as described by 'get_nt_in_pos'
-- and creates a @String@ for referencing purposes inside a TikZ picture.
nt_pos_to_internal_name :: (Int, Int) -> String
nt_pos_to_internal_name :: (Int, Int) -> [Char]
nt_pos_to_internal_name (Int
x,Int
y) = [Char]
"tikzsd_internal_nt_node_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
y)

-- | 'nt_pos_to_named_coord' gives the named @TikzCoordinate@ with name given by 
-- 'nf_pos_to_internal_name'.
-- This named coordinate can be used to refer to the @TikzPathOp@ node given by 
-- 'nt_nf_pos_to_nt_node'.
nt_pos_to_named_coord :: (Int, Int) -> TikzCoordinate
nt_pos_to_named_coord :: (Int, Int) -> TikzCoordinate
nt_pos_to_named_coord (Int
x,Int
y)= [Char] -> TikzCoordinate
NamedCoordinate ([Char] -> TikzCoordinate) -> [Char] -> TikzCoordinate
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Char]
nt_pos_to_internal_name (Int
x,Int
y)

-- | 'nt_max_pos_dimensions' takes one of the 5 types of @NaturalTransformation@
-- we can format (described by the documentation for 'NatFormatting') and returns
-- @(x,y)@.
-- If our natural transformation is viewed as a vertical composite of horizontal composites
-- of basic natural transformations, @x@ will equal the number of horizontal composites which
-- are being composed vertically, and @y@ will be the maximum number of basic natural
-- transformations in a horizontal composite.
nt_max_pos_dimensions :: NaturalTransformation -> (Int, Int)
nt_max_pos_dimensions :: NaturalTransformation -> (Int, Int)
nt_max_pos_dimensions (NaturalTransformation [Char]
_ [Char]
_ [Char]
_ OneGlobelet
_ [Char]
_) 
    = (Int
1,Int
1)
nt_max_pos_dimensions (NatTransVerticalComposite (OneGlobelet (CompositeFunctor ZeroGlobelet
_ []) (CompositeFunctor ZeroGlobelet
_ [])) []) 
    = (Int
0,Int
0)
nt_max_pos_dimensions (NatTransVerticalComposite (OneGlobelet (Functor [Char]
_ [Char]
_ ZeroGlobelet
_ [Char]
_) Functor
_ ) []) 
    = (Int
0,Int
0)
nt_max_pos_dimensions (NatTransHorizontalComposite OneGlobelet
_bg [NaturalTransformation]
nts) 
    = (Int
0, [NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([NaturalTransformation] -> Int) -> [NaturalTransformation] -> Int
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Bool)
-> [NaturalTransformation] -> [NaturalTransformation]
forall a. (a -> Bool) -> [a] -> [a]
filter NaturalTransformation -> Bool
is_basic_nt [NaturalTransformation]
nts)
nt_max_pos_dimensions (NatTransVerticalComposite OneGlobelet
_bg [NaturalTransformation]
nts) 
    = ([NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NaturalTransformation]
nts, [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Int) -> [NaturalTransformation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> b
snd((Int, Int) -> Int)
-> (NaturalTransformation -> (Int, Int))
-> NaturalTransformation
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NaturalTransformation -> (Int, Int)
nt_max_pos_dimensions) [NaturalTransformation]
nts)

-- | @(array_of_tikz_nt_nodes nt nf)@ is the array mapping pairs @(x,y)@
-- to the TikZ node path operation @(nt_nf_pos_to_nt_node nt nf (x,y))@.
-- If @(nt_max_pos_dimensions nt)@ is equal to @(a,b)@, then the bounds of the array
-- are @(0,0)@ to @(a-1,b-1)@.
array_of_tikz_nt_nodes :: NaturalTransformation -> NatFormatting -> Array (Int, Int) (Maybe TikzPathOperation)
array_of_tikz_nt_nodes :: NaturalTransformation
-> [FunctorFormatting]
-> Array (Int, Int) (Maybe TikzPathOperation)
array_of_tikz_nt_nodes NaturalTransformation
nt [FunctorFormatting]
nf = ((Int, Int), (Int, Int))
-> [((Int, Int), Maybe TikzPathOperation)]
-> Array (Int, Int) (Maybe TikzPathOperation)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int, Int), (Int, Int))
r [((Int, Int)
i,NaturalTransformation
-> [FunctorFormatting] -> (Int, Int) -> Maybe TikzPathOperation
nt_nf_pos_to_nt_node NaturalTransformation
nt [FunctorFormatting]
nf (Int, Int)
i) | (Int, Int)
i<- [(Int, Int)]
inds]
    where
        (Int
x,Int
y) = NaturalTransformation -> (Int, Int)
nt_max_pos_dimensions NaturalTransformation
nt
        r :: ((Int, Int), (Int, Int))
r = ((Int
0,Int
0),(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
        inds :: [(Int, Int)]
inds = ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int, Int), (Int, Int))
r

-- | A 'FunctorStringElement' is either
-- a @(FunctorElement (x,y))@, where @(x,y)@ can be converted to coordinates on a TikZ picture
-- using 'nf_pos_to_coord' (after specifying a 'NatFormatting')
-- or a @(NatElement (x,y))@, where @(x,y)@ can be converted to coordinates in a TikZ picture
-- using 'nt_nf_pos_to_coord' (after specifying a 'NaturalTransformation' and 'NatFormatting'
-- which can be used to format the 'NaturalTransformation').
data FunctorStringElement = FunctorElement (Int, Int) | NatElement (Int, Int) deriving (Int -> FunctorStringElement -> [Char] -> [Char]
[FunctorStringElement] -> [Char] -> [Char]
FunctorStringElement -> [Char]
(Int -> FunctorStringElement -> [Char] -> [Char])
-> (FunctorStringElement -> [Char])
-> ([FunctorStringElement] -> [Char] -> [Char])
-> Show FunctorStringElement
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [FunctorStringElement] -> [Char] -> [Char]
$cshowList :: [FunctorStringElement] -> [Char] -> [Char]
show :: FunctorStringElement -> [Char]
$cshow :: FunctorStringElement -> [Char]
showsPrec :: Int -> FunctorStringElement -> [Char] -> [Char]
$cshowsPrec :: Int -> FunctorStringElement -> [Char] -> [Char]
Show)

-- | A 'FunctorStringData' represents a string in a string diagram.
-- It consists of a list @fsd_list_of_elements@, which is a list of 'FunctorStringElement'
--  which the string goes between, @fsd_display_string@ which is LaTeX code for labeling the string,
--  and @fsd_options@ which is LaTeX code for options when labeling the string.
-- If the first element of the @fsd_list_of_elements@ is of the form @(FunctorElement (x,y))@,
-- the string in the string diagram starts from the top of the diagram, at the position specified by
-- the @FunctorElement@.
-- If the first element of the list is of the form @(NatElement (x,y))@,
-- the string starts at a basic natural transformation at the position
-- specified by the @NatElement@.
-- A similar statement holds for lists ending with @FunctorElement@ or @NatElement@.
-- All other positions on the list (i.e. not the first and not the last)
-- are occupied by a @(FunctorElement (x,y))@ representing positions where the string will pass
-- through.
--
-- The following assumptions on @fsd_list_of_elements@ are assumed to hold:
--
-- 1. All but possibly the first and the last element on the list are of the form
--  @(FunctorElement (x,y))@.
-- 2. The list contains at least one element of the form @(FunctorElement (x,y))@.
-- 3. If @(FunctorElement (x,y))@ and @(FunctorElement (z,w))@ are consecutive elements of the list,
--  then @z@ is equal to @x+1@.
-- 4. If @(NatElement (x,y))@ is the first element of the list and is followed by 
--  @(FunctorElement (z,w))@ then @z@ is equal to @x+1@.
-- 5. If @(NatElement (x,y))@ is the last element of the list and is preceded by 
--  @(FunctorElement (z,w))@ then @x@ is equal to @z@.
data FunctorStringData = FunctorStringData
    { FunctorStringData -> [FunctorStringElement]
fsd_list_of_elements :: ![FunctorStringElement]
    , FunctorStringData -> [Char]
fsd_display_string   :: !String
    , FunctorStringData -> [Char]
fsd_options          :: !String
    } deriving (Int -> FunctorStringData -> [Char] -> [Char]
[FunctorStringData] -> [Char] -> [Char]
FunctorStringData -> [Char]
(Int -> FunctorStringData -> [Char] -> [Char])
-> (FunctorStringData -> [Char])
-> ([FunctorStringData] -> [Char] -> [Char])
-> Show FunctorStringData
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [FunctorStringData] -> [Char] -> [Char]
$cshowList :: [FunctorStringData] -> [Char] -> [Char]
show :: FunctorStringData -> [Char]
$cshow :: FunctorStringData -> [Char]
showsPrec :: Int -> FunctorStringData -> [Char] -> [Char]
$cshowsPrec :: Int -> FunctorStringData -> [Char] -> [Char]
Show)

-- | 'fse_get_named_coord' gives the named coordinate associated to
-- a 'FunctorStringelement'.
-- It either calls 'pos_to_named_coord' in the case of 'FunctorElement',
-- or it calls 'nt_pos_to_named_coord' in the case of 'NatElement'.
fse_get_named_coord :: FunctorStringElement -> TikzCoordinate
fse_get_named_coord :: FunctorStringElement -> TikzCoordinate
fse_get_named_coord (FunctorElement (Int, Int)
x) = (Int, Int) -> TikzCoordinate
pos_to_named_coord (Int, Int)
x
fse_get_named_coord (NatElement (Int, Int)
x) = (Int, Int) -> TikzCoordinate
nt_pos_to_named_coord (Int, Int)
x

-- | 'fse_is_nat_elem' returns @True@ if the 'FunctorStringElement'
-- is of the form @(NatElement (x,y))@ and @False@ otherwise.
fse_is_nat_elem :: FunctorStringElement -> Bool
fse_is_nat_elem :: FunctorStringElement -> Bool
fse_is_nat_elem (NatElement (Int, Int)
_) = Bool
True
fse_is_nat_elem FunctorStringElement
_ = Bool
False

-- | 'fsd_head_position' is @Just (x,y)@ when the first element in
-- the @fsd_list_of_elements@ of the given
-- 'FunctorStringData' is @(FunctorElement (x,y))@, otherwise it is 
-- @Nothing@.
fsd_head_position :: FunctorStringData -> Maybe (Int, Int)
fsd_head_position :: FunctorStringData -> Maybe (Int, Int)
fsd_head_position FunctorStringData
fsd = let f :: FunctorStringElement
f = [FunctorStringElement] -> FunctorStringElement
forall a. [a] -> a
head ([FunctorStringElement] -> FunctorStringElement)
-> [FunctorStringElement] -> FunctorStringElement
forall a b. (a -> b) -> a -> b
$ FunctorStringData -> [FunctorStringElement]
fsd_list_of_elements FunctorStringData
fsd
    in case FunctorStringElement
f of (NatElement (Int, Int)
_) -> Maybe (Int, Int)
forall a. Maybe a
Nothing
                 (FunctorElement (Int
x,Int
y)) -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x,Int
y)

-- | 'fsd_tail_position' is @Just (x,y)@ when the last element in
-- the @fsd_list_of_elements@ of the given
-- 'FunctorStringData' is @(FunctorElement (x,y))@, otherwise it is 
-- @Nothing@.
fsd_tail_position :: FunctorStringData -> Maybe (Int, Int)
fsd_tail_position :: FunctorStringData -> Maybe (Int, Int)
fsd_tail_position FunctorStringData
fsd = let l :: FunctorStringElement
l = [FunctorStringElement] -> FunctorStringElement
forall a. [a] -> a
last ([FunctorStringElement] -> FunctorStringElement)
-> [FunctorStringElement] -> FunctorStringElement
forall a b. (a -> b) -> a -> b
$ FunctorStringData -> [FunctorStringElement]
fsd_list_of_elements FunctorStringData
fsd
    in case FunctorStringElement
l of (NatElement (Int, Int)
_) -> Maybe (Int, Int)
forall a. Maybe a
Nothing
                 (FunctorElement (Int
x,Int
y)) -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x,Int
y)

-- | 'fsd_combinable' is a Boolean value which tells whether two 
-- 'FunctorStringData'
-- can be combined together to form a longer 'FunctorStringData'.
-- 
-- Explicitly, it returns @True@ if the last element in
-- @fsd_list_of_elements@ of the first 'FunctorStringData' is of the form
-- @(FunctorElement (x,y))@ and is equal to the first
-- elementin @fsd_list_of_elements@ of the second 'FunctorStringData'.
fsd_combinable :: FunctorStringData -> FunctorStringData -> Bool
fsd_combinable :: FunctorStringData -> FunctorStringData -> Bool
fsd_combinable FunctorStringData
fsd1 FunctorStringData
fsd2 = (Maybe (Int, Int)
middle Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== FunctorStringData -> Maybe (Int, Int)
fsd_tail_position FunctorStringData
fsd1) Bool -> Bool -> Bool
&& (Maybe (Int, Int)
middle Maybe (Int, Int) -> Maybe (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Int, Int)
forall a. Maybe a
Nothing)
    where middle :: Maybe (Int, Int)
middle = FunctorStringData -> Maybe (Int, Int)
fsd_head_position FunctorStringData
fsd2

-- | If @(fsd_combinable fsd1 fsd2)@ is @True@, @(fsd_combine fsd1 fsd2)@
--  is the 'FunctorStringData' gotten by combining the @fsd_list_of_elements@ of @fsd1@ and @fsd2@,
--  which is done by identifying the common last element of of the first list with the first
--  element of the second.
-- The display string and options are taken from @fsd1@.
fsd_combine :: FunctorStringData -> FunctorStringData -> FunctorStringData
fsd_combine :: FunctorStringData -> FunctorStringData -> FunctorStringData
fsd_combine (FunctorStringData [FunctorStringElement]
l1 [Char]
ds1 [Char]
op1) (FunctorStringData [FunctorStringElement]
l2 [Char]
_ds2 [Char]
_op2) 
    = [FunctorStringElement] -> [Char] -> [Char] -> FunctorStringData
FunctorStringData [FunctorStringElement]
l3 [Char]
ds1 [Char]
op1
    where 
        l3 :: [FunctorStringElement]
l3 = [FunctorStringElement]
l1 [FunctorStringElement]
-> [FunctorStringElement] -> [FunctorStringElement]
forall a. [a] -> [a] -> [a]
++ ([FunctorStringElement] -> [FunctorStringElement]
forall a. [a] -> [a]
tail [FunctorStringElement]
l2)

-- | @(fsd_append fsd fse)@ appends the 'FunctorStringElement' @fse@
-- to the end of the @fsd_list_of_elements@ of @fsd@.
--
-- No check is done that the resulting 'fsd_list_of_elements' satisfies the
-- assumptions given in the documentation for 'FunctorStringData'.
fsd_append :: FunctorStringData -> FunctorStringElement -> FunctorStringData
fsd_append :: FunctorStringData -> FunctorStringElement -> FunctorStringData
fsd_append (FunctorStringData [FunctorStringElement]
loe [Char]
ds [Char]
op) FunctorStringElement
fe = [FunctorStringElement] -> [Char] -> [Char] -> FunctorStringData
FunctorStringData ([FunctorStringElement]
loe [FunctorStringElement]
-> [FunctorStringElement] -> [FunctorStringElement]
forall a. [a] -> [a] -> [a]
++ [FunctorStringElement
fe]) [Char]
ds [Char]
op

-- | @(fsd_prepend fse fsd)@ adds the 'FunctorStringElement' @fse@
-- to the start of the @fsd_list_of_elements@ of @fsd@.
--
-- No check is done that the resulting 'fsd_list_of_elements' satisfies the
-- assumptions given in the documentation for 'FunctorStringData'.
fsd_prepend :: FunctorStringElement -> FunctorStringData -> FunctorStringData
fsd_prepend :: FunctorStringElement -> FunctorStringData -> FunctorStringData
fsd_prepend FunctorStringElement
fe (FunctorStringData [FunctorStringElement]
loe [Char]
ds [Char]
op) = [FunctorStringElement] -> [Char] -> [Char] -> FunctorStringData
FunctorStringData (FunctorStringElement
feFunctorStringElement
-> [FunctorStringElement] -> [FunctorStringElement]
forall a. a -> [a] -> [a]
:[FunctorStringElement]
loe) [Char]
ds [Char]
op

-- | 'basic_func_to_fsd' takes a basic functor along with a position @(x,y)@
-- and gives the associated 'FunctorStringData' whose 
-- @fsd_list_of_elements@ is the singleton list containing @(FunctorElement (x,y))@.
basic_func_to_fsd :: Functor -> (Int, Int) -> FunctorStringData
basic_func_to_fsd :: Functor -> (Int, Int) -> FunctorStringData
basic_func_to_fsd (Functor [Char]
_id [Char]
ds ZeroGlobelet
_bg [Char]
op) (Int
x,Int
y) = [FunctorStringElement] -> [Char] -> [Char] -> FunctorStringData
FunctorStringData [FunctorStringElement]
fel [Char]
ds [Char]
op
    where 
        fel :: [FunctorStringElement]
fel = [(Int, Int) -> FunctorStringElement
FunctorElement (Int
x,Int
y)]
basic_func_to_fsd Functor
_ (Int, Int)
_ = [Char] -> FunctorStringData
forall a. HasCallStack => [Char] -> a
error [Char]
"basic_func_to_fsd is only defined for basic functors."

-- | An 'OrderedFSDList' is a list of 'FunctorStringData'
-- assumed to satisfy the following axioms on the order of its elements:
--
-- 1. @filter (\x-> x/=Nothing) (map fsd_head_position fsds)@ is equal to @[Just (r,0), ..., Just (r,n)]@
--          for some @r@ and @n@
--
-- 2. @filter (\x-> x/=Nothing) (map fsd_tail_position fsds)@ is equal to @[Just (s,0), ..., Just (s,m)]@
--          for some @s@ and @m@
--
-- 3. @r<=s@ when both @r@ and @s@ are uniquely determined (i.e. the above lists are nonempty).
type OrderedFSDList = [FunctorStringData]


-- | 'func_to_fsds' takes a 'Functor',
-- an @Int@ representing a row and an @Int@ representing an offset
-- and returns an 'OrderedFSDList'.
-- 
-- Decomposing the @Functor@ into a composition of basic functors, each
-- basic functor corresponds to one element of the 'OrderedFSDList'.
-- The 'FunctorStringData' in this list are created with
-- 'basic_func_to_fsd', with the basic functors placed at
-- @(r,o),(r,o+1),...,(r,o+n-1)@ where @r@ is the given row,
-- @o@ is the given offset, and @n@ is equal to 'func_reduced_length'
-- of the given functor.
func_to_fsds :: Functor -> Int -> Int -> OrderedFSDList
func_to_fsds :: Functor -> Int -> Int -> [FunctorStringData]
func_to_fsds Functor
fun Int
row Int
offset= (Functor -> (Int, Int) -> FunctorStringData)
-> [Functor] -> [(Int, Int)] -> [FunctorStringData]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Functor -> (Int, Int) -> FunctorStringData
basic_func_to_fsd [Functor]
functors [(Int, Int)]
coords
    where 
        functors :: [Functor]
functors = Functor -> [Functor]
func_to_single_list Functor
fun
        n :: Int
n = [Functor] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Functor]
functors
        coords :: [(Int, Int)]
coords = (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
y -> (Int
row,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset)) [Int
0..(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]

-- | If @fsds1@ and @fsds2@ are two 'OrderedFSDList' for which 
-- there exists a pair @(x,y)@ of nonnegative integers such that
--
--      - @filter (\x-> x/=Nothing) (map fsd_tail_position fsds1)@ 
--        is equal to @filter (\x-> x/=Nothing) (map fsd_head_position fsds2)@ which
--        is equal to @[Just (x,0), ..., Just (x,y)]@,
--
-- then @(fsds_amalg fsds1 fsds2)@ is an 'OrderedFSDList' which contains
--
--  - the @fsd@ in @fsds1@ for which @(fsd_tail_position fsd)@ is equal to @Nothing@
--  
--  - the @fsd@ in @fsds2@ for which @(fsd_head_position fsd)@ is equal to @Nothing@
--
--  - @(fsd_combine fsd1 fsd2)@ where @fsd1@ is in @fsds1@ and @fsd2@ is in @fsds2@
--    and @(fsd_combinable fsd1 fsd2)@ is @True@.
fsds_amalg :: OrderedFSDList -> OrderedFSDList -> OrderedFSDList
fsds_amalg :: [FunctorStringData] -> [FunctorStringData] -> [FunctorStringData]
fsds_amalg [FunctorStringData]
fsds [] = [FunctorStringData]
fsds
fsds_amalg [] [FunctorStringData]
fsds = [FunctorStringData]
fsds
fsds_amalg (FunctorStringData
x:[FunctorStringData]
xs) (FunctorStringData
y:[FunctorStringData]
ys) = case (FunctorStringData -> Maybe (Int, Int)
fsd_tail_position FunctorStringData
x, FunctorStringData -> Maybe (Int, Int)
fsd_head_position FunctorStringData
y) 
                                of (Maybe (Int, Int)
Nothing, Maybe (Int, Int)
_) -> FunctorStringData
xFunctorStringData -> [FunctorStringData] -> [FunctorStringData]
forall a. a -> [a] -> [a]
:([FunctorStringData] -> [FunctorStringData] -> [FunctorStringData]
fsds_amalg [FunctorStringData]
xs (FunctorStringData
yFunctorStringData -> [FunctorStringData] -> [FunctorStringData]
forall a. a -> [a] -> [a]
:[FunctorStringData]
ys))
                                   (Maybe (Int, Int)
_, Maybe (Int, Int)
Nothing) -> FunctorStringData
yFunctorStringData -> [FunctorStringData] -> [FunctorStringData]
forall a. a -> [a] -> [a]
:([FunctorStringData] -> [FunctorStringData] -> [FunctorStringData]
fsds_amalg (FunctorStringData
xFunctorStringData -> [FunctorStringData] -> [FunctorStringData]
forall a. a -> [a] -> [a]
:[FunctorStringData]
xs) [FunctorStringData]
ys)
                                   (Maybe (Int, Int), Maybe (Int, Int))
_ -> (FunctorStringData -> FunctorStringData -> FunctorStringData
fsd_combine FunctorStringData
x FunctorStringData
yFunctorStringData -> [FunctorStringData] -> [FunctorStringData]
forall a. a -> [a] -> [a]
:([FunctorStringData] -> [FunctorStringData] -> [FunctorStringData]
fsds_amalg [FunctorStringData]
xs [FunctorStringData]
ys))

-- | 'nt_to_functor_strings' takes a 'NaturalTransformation' of one of the 5 types
-- of the 'NaturalTransformation' which we can format (see 'NatFormatting') and returns
-- and 'OrderedFSDList' containing a list of 'FunctorStringData' representing all the 
-- strings in the string diagram for the given natural transformation.
nt_to_functor_strings :: NaturalTransformation -> OrderedFSDList
nt_to_functor_strings :: NaturalTransformation -> [FunctorStringData]
nt_to_functor_strings (NaturalTransformation [Char]
n [Char]
d [Char]
s OneGlobelet
b [Char]
o) 
    = NaturalTransformation
-> Int -> Int -> Int -> Int -> [FunctorStringData]
nt_to_functor_strings_helper ([Char]
-> [Char]
-> [Char]
-> OneGlobelet
-> [Char]
-> NaturalTransformation
NaturalTransformation [Char]
n [Char]
d [Char]
s OneGlobelet
b [Char]
o) Int
0 Int
0 Int
0 Int
0 
nt_to_functor_strings (NatTransVerticalComposite (OneGlobelet (CompositeFunctor ZeroGlobelet
_ []) (CompositeFunctor ZeroGlobelet
_ [])) []) 
    = []
nt_to_functor_strings (NatTransVerticalComposite (OneGlobelet (Functor [Char]
_i [Char]
d ZeroGlobelet
_b [Char]
o) Functor
_ ) []) = [FunctorStringData
fsd]
    where fsd :: FunctorStringData
fsd = [FunctorStringElement] -> [Char] -> [Char] -> FunctorStringData
FunctorStringData [(Int, Int) -> FunctorStringElement
FunctorElement (Int
0,Int
0), (Int, Int) -> FunctorStringElement
FunctorElement (Int
1,Int
0)] [Char]
d [Char]
o
nt_to_functor_strings (NatTransHorizontalComposite OneGlobelet
g [NaturalTransformation]
nats) 
    = NaturalTransformation
-> Int -> Int -> Int -> Int -> [FunctorStringData]
nt_to_functor_strings_helper (OneGlobelet -> [NaturalTransformation] -> NaturalTransformation
NatTransHorizontalComposite OneGlobelet
g [NaturalTransformation]
nats) Int
0 Int
0 Int
0 Int
0
nt_to_functor_strings (NatTransVerticalComposite OneGlobelet
_bg [NaturalTransformation]
nts) = ([FunctorStringData] -> [FunctorStringData] -> [FunctorStringData])
-> [FunctorStringData]
-> [[FunctorStringData]]
-> [FunctorStringData]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [FunctorStringData] -> [FunctorStringData] -> [FunctorStringData]
fsds_amalg [FunctorStringData]
a [[FunctorStringData]]
as
    where
        ([FunctorStringData]
a:[[FunctorStringData]]
as) = (NaturalTransformation
 -> Int -> Int -> Int -> Int -> [FunctorStringData])
-> [NaturalTransformation]
-> [Int]
-> [Int]
-> [Int]
-> [Int]
-> [[FunctorStringData]]
forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
zipWith5 NaturalTransformation
-> Int -> Int -> Int -> Int -> [FunctorStringData]
nt_to_functor_strings_helper 
                    [NaturalTransformation]
nts [Int
0..(([NaturalTransformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NaturalTransformation]
nts) Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] (Int -> [Int]
forall a. a -> [a]
repeat Int
0) (Int -> [Int]
forall a. a -> [a]
repeat Int
0) (Int -> [Int]
forall a. a -> [a]
repeat Int
0)

-- | A helper function for 'nt_to_functor_strings'.
nt_to_functor_strings_helper :: NaturalTransformation -> Int -> Int -> Int -> Int -> [FunctorStringData]
nt_to_functor_strings_helper :: NaturalTransformation
-> Int -> Int -> Int -> Int -> [FunctorStringData]
nt_to_functor_strings_helper (NaturalTransformation [Char]
_n [Char]
_d [Char]
_s OneGlobelet
b [Char]
_o) Int
row Int
top_offset Int
bot_offset Int
offset
    = [FunctorStringData]
fsds1 [FunctorStringData] -> [FunctorStringData] -> [FunctorStringData]
forall a. [a] -> [a] -> [a]
++ [FunctorStringData]
fsds2
    where 
        source_fun_fsds :: [FunctorStringData]
source_fun_fsds = Functor -> Int -> Int -> [FunctorStringData]
func_to_fsds (OneGlobelet -> Functor
glob1_source OneGlobelet
b) Int
row Int
top_offset
        target_fun_fsds :: [FunctorStringData]
target_fun_fsds = Functor -> Int -> Int -> [FunctorStringData]
func_to_fsds (OneGlobelet -> Functor
glob1_target OneGlobelet
b) (Int
rowInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
bot_offset
        fsds1 :: [FunctorStringData]
fsds1 = (FunctorStringData -> FunctorStringData)
-> [FunctorStringData] -> [FunctorStringData]
forall a b. (a -> b) -> [a] -> [b]
map (\FunctorStringData
fsd -> FunctorStringData -> FunctorStringElement -> FunctorStringData
fsd_append FunctorStringData
fsd ((Int, Int) -> FunctorStringElement
NatElement (Int
row,Int
offset))) [FunctorStringData]
source_fun_fsds
        fsds2 :: [FunctorStringData]
fsds2 = (FunctorStringData -> FunctorStringData)
-> [FunctorStringData] -> [FunctorStringData]
forall a b. (a -> b) -> [a] -> [b]
map (\FunctorStringData
fsd -> FunctorStringElement -> FunctorStringData -> FunctorStringData
fsd_prepend ((Int, Int) -> FunctorStringElement
NatElement (Int
row,Int
offset)) FunctorStringData
fsd) [FunctorStringData]
target_fun_fsds
nt_to_functor_strings_helper (NatTransVerticalComposite (OneGlobelet (CompositeFunctor ZeroGlobelet
_ []) (CompositeFunctor ZeroGlobelet
_ [])) []) 
    Int
_ Int
_ Int
_ Int
_ 
    = []
nt_to_functor_strings_helper (NatTransVerticalComposite (OneGlobelet (Functor [Char]
_i [Char]
d ZeroGlobelet
_b [Char]
o) Functor
_ ) []) Int
row Int
top_offset Int
bot_offset Int
_ 
    = [FunctorStringData
fsd]
    where
        fsd :: FunctorStringData
fsd = [FunctorStringElement] -> [Char] -> [Char] -> FunctorStringData
FunctorStringData [(Int, Int) -> FunctorStringElement
FunctorElement (Int
row,Int
top_offset), (Int, Int) -> FunctorStringElement
FunctorElement (Int
rowInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
bot_offset)] [Char]
d [Char]
o
nt_to_functor_strings_helper (NatTransHorizontalComposite OneGlobelet
_g [NaturalTransformation]
nats) Int
row Int
top_offset Int
bot_offset Int
offset
    = [[FunctorStringData]] -> [FunctorStringData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FunctorStringData]] -> [FunctorStringData])
-> [[FunctorStringData]] -> [FunctorStringData]
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation
 -> Int -> Int -> Int -> Int -> [FunctorStringData])
-> [NaturalTransformation]
-> [Int]
-> [Int]
-> [Int]
-> [Int]
-> [[FunctorStringData]]
forall a b c d e f.
(a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
zipWith5 NaturalTransformation
-> Int -> Int -> Int -> Int -> [FunctorStringData]
nt_to_functor_strings_helper [NaturalTransformation]
nats (Int -> [Int]
forall a. a -> [a]
repeat Int
row) [Int]
toffs [Int]
boffs [Int]
offs
    where
        toffs :: [Int]
toffs = ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
top_offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+)(Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum) ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
inits ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Int) -> [NaturalTransformation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NaturalTransformation -> Int
nat_source_length [NaturalTransformation]
nats
        boffs :: [Int]
boffs = ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
bot_offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+)(Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum) ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
inits ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Int) -> [NaturalTransformation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NaturalTransformation -> Int
nat_target_length [NaturalTransformation]
nats
        offs :: [Int]
offs = ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+)(Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum) ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
inits ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (NaturalTransformation -> Int) -> [NaturalTransformation] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Int
forall a. Enum a => a -> Int
fromEnum(Bool -> Int)
-> (NaturalTransformation -> Bool) -> NaturalTransformation -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NaturalTransformation -> Bool
is_basic_nt) [NaturalTransformation]
nats
nt_to_functor_strings_helper NaturalTransformation
_ Int
_ Int
_ Int
_ Int
_ 
    = [Char] -> [FunctorStringData]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [FunctorStringData]) -> [Char] -> [FunctorStringData]
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: The function nt_to_functor_strings_helper "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"should only be defined for a row of natural transformations, "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"i.e. it is only defined for natural transformations of types "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"1 through 4 given in the documentation for NatFormatting."

-- | 'fsd_get_mid' returns the placement of the midpoint of a list of 'FunctorStringElement's.
-- Here the length between two consecutive 'FunctorStringElement' in the list is gotten using
-- 'fsd_lengths'.
--
-- It returns @(n,f)@ where @n@ is the index of the segment where the midpoint is located
-- (with the first segment being indexed by @0@) and
-- @f@ is on the interval [0,1) and specifies how far into this segment the midpoint is located.
fsd_get_mid :: [FunctorStringElement] -> (Int, Float)
fsd_get_mid :: [FunctorStringElement] -> (Int, Float)
fsd_get_mid [FunctorStringElement]
loe = Int -> Int -> [Int] -> (Int, Float)
fsd_get_mid_helper Int
mid Int
0 [Int]
ls
    where
        ls :: [Int]
ls = [FunctorStringElement] -> [Int]
fsd_lengths [FunctorStringElement]
loe
        mid :: Int
mid = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ls) Int
2
        fsd_get_mid_helper :: Int -> Int -> [Int] -> (Int,Float)
        fsd_get_mid_helper :: Int -> Int -> [Int] -> (Int, Float)
fsd_get_mid_helper Int
rem_len Int
pos (Int
x:[Int]
xs) = if Int
rem_lenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
x 
                                                then (Int
pos,(Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rem_len)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/(Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x))
                                                else Int -> Int -> [Int] -> (Int, Float)
fsd_get_mid_helper (Int
rem_lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
xs
        fsd_get_mid_helper Int
_ Int
_  [] 
            = [Char] -> (Int, Float)
forall a. HasCallStack => [Char] -> a
error [Char]
"Error: the midpoint shouldn't be the endpoint or past the endpoint."

-- | 'fsd_lengths' gives the lengths of the segments, and is used in 'fsd_get_mid'.
-- Segments of the form @NatElement@ -- @FunctorStringElement@
--or @FunctorStringElement@ -- @NatElement@ have length 2, while
-- segments of the form @FunctorStringElement@ -- @FunctorStringElement@ have length 4.
fsd_lengths :: [FunctorStringElement] -> [Int]
fsd_lengths :: [FunctorStringElement] -> [Int]
fsd_lengths [FunctorStringElement]
loes = (FunctorStringElement -> FunctorStringElement -> Int)
-> [FunctorStringElement] -> [FunctorStringElement] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FunctorStringElement -> FunctorStringElement -> Int
seg_length [FunctorStringElement]
loes ([FunctorStringElement] -> [FunctorStringElement]
forall a. [a] -> [a]
tail [FunctorStringElement]
loes)

-- | 'seg_length' gives the length between two 'FunctorStringElement's, as described
-- in 'fsd_lengths'.
seg_length :: FunctorStringElement -> FunctorStringElement -> Int
seg_length :: FunctorStringElement -> FunctorStringElement -> Int
seg_length (NatElement (Int, Int)
_) (FunctorElement (Int, Int)
_)= Int
2
seg_length (FunctorElement (Int, Int)
_) (NatElement (Int, Int)
_)= Int
2
seg_length (FunctorElement (Int, Int)
_) (FunctorElement (Int, Int)
_) = Int
4
seg_length FunctorStringElement
_ FunctorStringElement
_ = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: The list of FunctorStringElements of a FunctorStringData "
                          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"should not have two consecutive NatElements"

-- | A helper function computing the coordinates of a control point under
-- the position described by a 'FunctorElement'.
fe_from_top_offset :: NatFormatting -> (Int,Int) -> Maybe TikzCoordinate
fe_from_top_offset :: [FunctorFormatting] -> (Int, Int) -> Maybe TikzCoordinate
fe_from_top_offset [FunctorFormatting]
nf (Int
x,Int
y) = do (Float
a,Float
b) <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
x,Int
y)
                                 TikzCoordinate -> Maybe TikzCoordinate
forall (m :: * -> *) a. Monad m => a -> m a
return (TikzCoordinate -> Maybe TikzCoordinate)
-> TikzCoordinate -> Maybe TikzCoordinate
forall a b. (a -> b) -> a -> b
$ Float -> Float -> TikzCoordinate
Canvas Float
a (Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
-Float
0.5)

-- | A helper function computing the coordinates of a control point over
-- the position described by a 'FunctorElement'.
fe_from_bot_offset :: NatFormatting -> (Int,Int) -> Maybe TikzCoordinate
fe_from_bot_offset :: [FunctorFormatting] -> (Int, Int) -> Maybe TikzCoordinate
fe_from_bot_offset [FunctorFormatting]
nf (Int
x,Int
y) = do (Float
a,Float
b) <- [FunctorFormatting] -> (Int, Int) -> Maybe (Float, Float)
nf_pos_to_coord [FunctorFormatting]
nf (Int
x,Int
y)
                                 TikzCoordinate -> Maybe TikzCoordinate
forall (m :: * -> *) a. Monad m => a -> m a
return (TikzCoordinate -> Maybe TikzCoordinate)
-> TikzCoordinate -> Maybe TikzCoordinate
forall a b. (a -> b) -> a -> b
$ Float -> Float -> TikzCoordinate
Canvas Float
a (Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
0.5)

-- | 'fse_fse_to_curve_op' takes a 'NatFormatting' and two consecutive 'FunctorStringElement's
-- in the 'fsd_list_of_elements' of a 'FunctorStringData' and creates a 'TikzPathOperation'
-- drawing the part of the string between the two points described by the
-- two 'FunctorStringElement's.
fse_fse_to_curve_op :: NatFormatting -> FunctorStringElement -> FunctorStringElement -> Maybe TikzPathOperation
fse_fse_to_curve_op :: [FunctorFormatting]
-> FunctorStringElement
-> FunctorStringElement
-> Maybe TikzPathOperation
fse_fse_to_curve_op [FunctorFormatting]
nf (FunctorElement (Int, Int)
x1) (FunctorElement (Int, Int)
x2) 
    = do TikzCoordinate
c1 <- [FunctorFormatting] -> (Int, Int) -> Maybe TikzCoordinate
fe_from_top_offset [FunctorFormatting]
nf (Int, Int)
x1
         TikzCoordinate
c2 <- [FunctorFormatting] -> (Int, Int) -> Maybe TikzCoordinate
fe_from_bot_offset [FunctorFormatting]
nf (Int, Int)
x2
         TikzPathOperation -> Maybe TikzPathOperation
forall (m :: * -> *) a. Monad m => a -> m a
return (TikzPathOperation -> Maybe TikzPathOperation)
-> TikzPathOperation -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ TikzCoordinate
-> TikzCoordinate -> TikzCoordinate -> TikzPathOperation
PathOpCurveToTwoControls ((Int, Int) -> TikzCoordinate
pos_to_named_coord (Int, Int)
x2) TikzCoordinate
c1 TikzCoordinate
c2
fse_fse_to_curve_op [FunctorFormatting]
nf (FunctorElement (Int, Int)
x1) (NatElement (Int, Int)
x2) 
    = do TikzCoordinate
c <- [FunctorFormatting] -> (Int, Int) -> Maybe TikzCoordinate
fe_from_top_offset [FunctorFormatting]
nf (Int, Int)
x1
         TikzPathOperation -> Maybe TikzPathOperation
forall (m :: * -> *) a. Monad m => a -> m a
return (TikzPathOperation -> Maybe TikzPathOperation)
-> TikzPathOperation -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ TikzCoordinate -> TikzCoordinate -> TikzPathOperation
PathOpCurveToOneControl ((Int, Int) -> TikzCoordinate
nt_pos_to_named_coord (Int, Int)
x2) TikzCoordinate
c
fse_fse_to_curve_op [FunctorFormatting]
nf (NatElement (Int, Int)
_x1) (FunctorElement (Int, Int)
x2) 
    = do TikzCoordinate
c <- [FunctorFormatting] -> (Int, Int) -> Maybe TikzCoordinate
fe_from_bot_offset [FunctorFormatting]
nf (Int, Int)
x2
         TikzPathOperation -> Maybe TikzPathOperation
forall (m :: * -> *) a. Monad m => a -> m a
return (TikzPathOperation -> Maybe TikzPathOperation)
-> TikzPathOperation -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ TikzCoordinate -> TikzCoordinate -> TikzPathOperation
PathOpCurveToOneControl ((Int, Int) -> TikzCoordinate
pos_to_named_coord (Int, Int)
x2) TikzCoordinate
c
fse_fse_to_curve_op [FunctorFormatting]
_ FunctorStringElement
_ FunctorStringElement
_ = [Char] -> Maybe TikzPathOperation
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe TikzPathOperation)
-> [Char] -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: The list of FunctorStringElements of a FunctorStringData "
                                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"should not have two consecutive NatElements"

-- | 'fsd_to_tikz_path' takes a 'NatFormatting' and a 'FunctorStringData'
-- and gives the 'TikzPath' which draws the string in the string diagram
-- represented by the 'FunctorStringData'.
fsd_to_tikz_path :: NatFormatting -> FunctorStringData -> TikzPath
fsd_to_tikz_path :: [FunctorFormatting] -> FunctorStringData -> TikzPath
fsd_to_tikz_path [FunctorFormatting]
nf (FunctorStringData [FunctorStringElement]
fses [Char]
ds [Char]
opts) = [Maybe TikzPathOperation] -> TikzPath
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TikzPathOperation] -> TikzPath)
-> [Maybe TikzPathOperation] -> TikzPath
forall a b. (a -> b) -> a -> b
$ Maybe TikzPathOperation
aMaybe TikzPathOperation
-> [Maybe TikzPathOperation] -> [Maybe TikzPathOperation]
forall a. a -> [a] -> [a]
:Maybe TikzPathOperation
bMaybe TikzPathOperation
-> [Maybe TikzPathOperation] -> [Maybe TikzPathOperation]
forall a. a -> [a] -> [a]
:[Maybe TikzPathOperation]
rest
    where
        a :: Maybe TikzPathOperation
a = TikzPathOperation -> Maybe TikzPathOperation
forall a. a -> Maybe a
Just (TikzPathOperation -> Maybe TikzPathOperation)
-> TikzPathOperation -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ [Char] -> TikzPathOperation
PathOpOption [Char]
"draw"
        b :: Maybe TikzPathOperation
b = TikzPathOperation -> Maybe TikzPathOperation
forall a. a -> Maybe a
Just (TikzPathOperation -> Maybe TikzPathOperation)
-> TikzPathOperation -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ TikzCoordinate -> TikzPathOperation
PathOpMoveTo (TikzCoordinate -> TikzPathOperation)
-> TikzCoordinate -> TikzPathOperation
forall a b. (a -> b) -> a -> b
$ FunctorStringElement -> TikzCoordinate
fse_get_named_coord (FunctorStringElement -> TikzCoordinate)
-> FunctorStringElement -> TikzCoordinate
forall a b. (a -> b) -> a -> b
$ [FunctorStringElement] -> FunctorStringElement
forall a. [a] -> a
head ([FunctorStringElement] -> FunctorStringElement)
-> [FunctorStringElement] -> FunctorStringElement
forall a b. (a -> b) -> a -> b
$ [FunctorStringElement]
fses
        i :: (Int, Float)
i = [FunctorStringElement] -> (Int, Float)
fsd_get_mid [FunctorStringElement]
fses
        rest :: [Maybe TikzPathOperation]
rest = (Int, Float)
-> [FunctorFormatting]
-> [FunctorStringElement]
-> [Char]
-> [Char]
-> [Maybe TikzPathOperation]
fsd_to_tikz_path_helper (Int, Float)
i [FunctorFormatting]
nf [FunctorStringElement]
fses [Char]
opts [Char]
ds

-- | A helper function for 'fsd_to_tikz_path'.
fsd_to_tikz_path_helper :: (Int,Float) -> NatFormatting -> [FunctorStringElement] -> String -> String 
                            -> [Maybe TikzPathOperation]
fsd_to_tikz_path_helper :: (Int, Float)
-> [FunctorFormatting]
-> [FunctorStringElement]
-> [Char]
-> [Char]
-> [Maybe TikzPathOperation]
fsd_to_tikz_path_helper (Int
0,Float
pos) [FunctorFormatting]
nf (FunctorStringElement
fse1:FunctorStringElement
fse2:[FunctorStringElement]
rest) [Char]
opt [Char]
ds = Maybe TikzPathOperation
aMaybe TikzPathOperation
-> [Maybe TikzPathOperation] -> [Maybe TikzPathOperation]
forall a. a -> [a] -> [a]
:Maybe TikzPathOperation
bMaybe TikzPathOperation
-> [Maybe TikzPathOperation] -> [Maybe TikzPathOperation]
forall a. a -> [a] -> [a]
:[Maybe TikzPathOperation]
continuation
    where 
        a :: Maybe TikzPathOperation
a = [FunctorFormatting]
-> FunctorStringElement
-> FunctorStringElement
-> Maybe TikzPathOperation
fse_fse_to_curve_op [FunctorFormatting]
nf FunctorStringElement
fse1 FunctorStringElement
fse2
        b :: Maybe TikzPathOperation
b = TikzPathOperation -> Maybe TikzPathOperation
forall a. a -> Maybe a
Just (TikzPathOperation -> Maybe TikzPathOperation)
-> TikzPathOperation -> Maybe TikzPathOperation
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> TikzPathOperation
PathOpRelativeNode ([Char]
"pos="[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Float -> [Char]
forall a. Show a => a -> [Char]
show Float
pos)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
",auto,"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
opt) [Char]
ds
        continuation :: [Maybe TikzPathOperation]
continuation = (FunctorStringElement
 -> FunctorStringElement -> Maybe TikzPathOperation)
-> [FunctorStringElement]
-> [FunctorStringElement]
-> [Maybe TikzPathOperation]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([FunctorFormatting]
-> FunctorStringElement
-> FunctorStringElement
-> Maybe TikzPathOperation
fse_fse_to_curve_op [FunctorFormatting]
nf) (FunctorStringElement
fse2FunctorStringElement
-> [FunctorStringElement] -> [FunctorStringElement]
forall a. a -> [a] -> [a]
:[FunctorStringElement]
rest) [FunctorStringElement]
rest
fsd_to_tikz_path_helper (Int
n,Float
pos) [FunctorFormatting]
nf (FunctorStringElement
fse1:FunctorStringElement
fse2:[FunctorStringElement]
rest) [Char]
opt [Char]
ds 
    = Maybe TikzPathOperation
aMaybe TikzPathOperation
-> [Maybe TikzPathOperation] -> [Maybe TikzPathOperation]
forall a. a -> [a] -> [a]
:(Int, Float)
-> [FunctorFormatting]
-> [FunctorStringElement]
-> [Char]
-> [Char]
-> [Maybe TikzPathOperation]
fsd_to_tikz_path_helper (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Float
pos) [FunctorFormatting]
nf (FunctorStringElement
fse2FunctorStringElement
-> [FunctorStringElement] -> [FunctorStringElement]
forall a. a -> [a] -> [a]
:[FunctorStringElement]
rest) [Char]
opt [Char]
ds
    where
        a :: Maybe TikzPathOperation
a = [FunctorFormatting]
-> FunctorStringElement
-> FunctorStringElement
-> Maybe TikzPathOperation
fse_fse_to_curve_op [FunctorFormatting]
nf FunctorStringElement
fse1 FunctorStringElement
fse2
fsd_to_tikz_path_helper (Int, Float)
_ [FunctorFormatting]
_ [FunctorStringElement]
_ [Char]
_ [Char]
_ = [Char] -> [Maybe TikzPathOperation]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Maybe TikzPathOperation])
-> [Char] -> [Maybe TikzPathOperation]
forall a b. (a -> b) -> a -> b
$ [Char]
"Error. The list of FunctorStringElements of a completed "
                                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"FunctorStringData should have at least two elements."