-- |
-- Module      :  Languages.UniquenessPeriods.Vector.General.DebugG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization of the functionality of the DobutokO.Poetry.General.Debug
-- module from the @dobutokO-poetry-general-languages@ package.
--
{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Languages.UniquenessPeriods.Vector.General.DebugG (
  -- * Pure functions
  -- ** Self-recursive pure functions and connected with them ones
  maximumElBy
  , uniqNPropertiesN
  , uniqNPropertiesNAll
  , uniqNProperties2GN
  -- ** Pure functions
  , maximumElByAll
  , maximumElGBy
  , uniquenessVariantsGN
  , maximumElByVec
  , maximumElByVecAll
  -- * IO functions
  -- ** Printing subsystem
  , toFile
  , toFileStr
  , printUniquenessG1
  , printUniquenessG1List
  -- *** With 'String'-based arguments
  , printUniquenessG1ListStr
  -- *** With 'VB.Vector' 'Char' based arguments
  , printUniquenessG1VChar
  -- *** Auxiliary functions
  , newLineEnding
  , equalSnDs
) where

import Data.Foldable
import Data.Monoid
import Data.SubG
import Data.Print.Info
import System.IO
import qualified Data.Vector as VB
import Languages.UniquenessPeriods.Vector.AuxiliaryG
import Languages.UniquenessPeriods.Vector.StrictVG
import Languages.UniquenessPeriods.Vector.DataG

-- | The function evaluates the 'VB.Vector' of 'UniquenessG1T2' @t@ @t2@ @a@ @b@ elements (related with the third argument) to retrieve the possibly maximum element
-- in it with respect to the order and significance (principality)  of the \"properties\" (represented as the functions @f :: [b] -> b@) being evaluated.
-- The most significant and principal is the \"property\", which index in the 'VB.Vector' of them is the 'Int' argument (so it is the first one) of the
-- function minus 1, then less significant is the next to the left \"property\" and so on.
-- The predefined library \"properties\" or related to them functions can be found in the package @phonetic-languages-properties@.
maximumElBy ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b) => Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  ->  UniqG2T2 t t2 a b -- ^ The data to be analyzed.
  -> UniquenessG1T2 t t2 a b -- ^ The maximum element in respect with the given parameters.
maximumElBy :: Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
maximumElBy Int
k Vector (t2 b -> b)
vN UniqG2T2 t t2 a b
y
 | Vector (UniquenessG1T2 t t2 a b) -> Bool
forall a. Vector a -> Bool
VB.null (Vector (UniquenessG1T2 t t2 a b) -> Bool)
-> (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> b
snd ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> Bool) -> UniqG2T2 t t2 a b -> Bool
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
y = [Char] -> UniquenessG1T2 t t2 a b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.General.DebugG.maximumElBy: undefined for the empty second element in the tuple. "
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = [Char] -> UniquenessG1T2 t t2 a b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.General.DebugG.maximumElBy: undefined for that amount of norms. "
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
   let !maxK :: UniquenessG1T2 t t2 a b
maxK = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) (Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b)
-> (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> b
snd ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> UniquenessG1T2 t t2 a b)
-> UniqG2T2 t t2 a b -> UniquenessG1T2 t t2 a b
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
y
       vK :: Vector (UniquenessG1T2 t t2 a b)
vK = (UniquenessG1T2 t t2 a b -> Bool)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\(t2 b
_,Vector b
vN2,t a
_) -> Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
maxK) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Vector (UniquenessG1T2 t t2 a b)
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> b
snd ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
y in
         Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
maximumElBy (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int -> Vector (t2 b -> b) -> Vector (t2 b -> b)
forall a. Int -> Int -> Vector a -> Vector a
VB.unsafeSlice Int
0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector (t2 b -> b)
vN) ((Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
forall a b. (Vector a, b) -> UniquenessG2 a b
UL2 ((Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> a
fst ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
y,Vector (UniquenessG1T2 t t2 a b)
vK))
 | Bool
otherwise = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 Int
0) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 Int
0)) (Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b)
-> (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> b
snd ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> UniquenessG1T2 t t2 a b)
-> UniqG2T2 t t2 a b -> UniquenessG1T2 t t2 a b
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
y
{-# NOINLINE maximumElBy #-}

-- | Prints every element from the structure on the new line to the file. Uses 'appendFile' function inside.
toFile ::
  (Foldable t, Show (t a), Monoid (t a)) => FilePath -- ^ The 'FilePath' to the file to be written in the 'AppendMode' (actually appended with) the information output.
  -> t (t a) -- ^ Each element is appended on the new line to the file.
  -> IO ()
toFile :: [Char] -> t (t a) -> IO ()
toFile [Char]
file t (t a)
xss = (t a -> IO ()) -> t (t a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\t a
xs -> [Char] -> [Char] -> IO ()
appendFile [Char]
file (t a -> [Char]
forall a. Show a => a -> [Char]
show t a
xs [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding)) t (t a)
xss

-- | Prints every 'String' from the list on the new line to the file. Uses 'appendFile' function inside.
toFileStr ::
  FilePath -- ^ The 'FilePath' to the file to be written in the 'AppendMode' (actually appended with) the information output.
  -> [String] -- ^ Each 'String' is appended on the new line to the file.
  -> IO ()
toFileStr :: [Char] -> [[Char]] -> IO ()
toFileStr [Char]
file [[Char]]
xss = ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
xs -> [Char] -> [Char] -> IO ()
appendFile [Char]
file ([Char]
xs [Char] -> [Char] -> [Char]
forall a. Monoid a => a -> a -> a
`mappend` [Char]
newLineEnding)) [[Char]]
xss

-- | Is used to print output specified to the 'stdout' or to the 'FilePath' specified as the inner argument in the 'Info2' parameter.
printUniquenessG1
  :: (Show (t a), Show b, Show (t2 b)) => Info2 -- ^ A parameter to control the predefined behaviour of the printing. The 'I1' branch prints to the 'stdout' and the 'I2' - to the file.
  -> UniquenessG1T2 t t2 a b -- ^ The element, for which the information is printed.
  -> IO ()
printUniquenessG1 :: Info2 -> UniquenessG1T2 t t2 a b -> IO ()
printUniquenessG1 Info2
info UniquenessG1T2 t t2 a b
uni
  | Info2 -> Bool
forall a b. InfoG a b -> Bool
isI1 Info2
info =
      case (\(I1 Info
x) -> Info
x) Info2
info of
        Info
A -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Info
B -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Info
C -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Info
D -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Info
E -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Info
F -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Info
G -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Info
_ -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, Vector b -> [Char]
forall a. Show a => a -> [Char]
show(Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]  -- the most verbose output
  | Bool
otherwise =
      case (\(I2 InfoFile
x) -> InfoFile
x) Info2
info of
        Af [Char]
_ -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Bf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Cf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Df [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Ef [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Ff [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        Gf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]
        ~(Hf [Char]
xs) -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs [t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni, Vector b -> [Char]
forall a. Show a => a -> [Char]
show(Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b -> [Char]
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
uni]  -- the most verbose output

-- | Is used to print output specified to the 'stdout' or to the 'FilePath' specified as the inner argument in the 'Info2' parameter.
printUniquenessG1List
  :: (Show (t a), Show b, Show (t2 b)) => Info2 -- ^ A parameter to control the predefined behaviour of the printing. The 'I1' branch prints to the 'stdout' and the 'I2' - to the file.
  -> [UniquenessG1T2 t t2 a b] -- ^ The list of elements, for which the information is printed.
  -> IO ()
printUniquenessG1List :: Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
printUniquenessG1List Info2
info (UniquenessG1T2 t t2 a b
y:[UniquenessG1T2 t t2 a b]
ys)
  | Info2 -> Bool
forall a b. InfoG a b -> Bool
isI1 Info2
info =
      case (\(I1 Info
x) -> Info
x) Info2
info of
        Info
A -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Info
B -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ (UniquenessG1T2 t t2 a b
yUniquenessG1T2 t t2 a b
-> [UniquenessG1T2 t t2 a b] -> [UniquenessG1T2 t t2 a b]
forall a. a -> [a] -> [a]
:[UniquenessG1T2 t t2 a b]
ys)
        Info
C -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ (UniquenessG1T2 t t2 a b
yUniquenessG1T2 t t2 a b
-> [UniquenessG1T2 t t2 a b] -> [UniquenessG1T2 t t2 a b]
forall a. a -> [a] -> [a]
:[UniquenessG1T2 t t2 a b]
ys)
        Info
D -> ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ (UniquenessG1T2 t t2 a b
yUniquenessG1T2 t t2 a b
-> [UniquenessG1T2 t t2 a b] -> [UniquenessG1T2 t t2 a b]
forall a. a -> [a] -> [a]
:[UniquenessG1T2 t t2 a b]
ys)
        Info
E -> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
forall (t :: * -> *) a b (t2 :: * -> *).
(Show (t a), Show b, Show (t2 b)) =>
Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
printUniquenessG1List Info2
info [UniquenessG1T2 t t2 a b]
ys
        Info
F -> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
forall (t :: * -> *) a b (t2 :: * -> *).
(Show (t a), Show b, Show (t2 b)) =>
Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
printUniquenessG1List Info2
info [UniquenessG1T2 t t2 a b]
ys
        Info
G -> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
forall (t :: * -> *) a b (t2 :: * -> *).
(Show (t a), Show b, Show (t2 b)) =>
Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
printUniquenessG1List Info2
info [UniquenessG1T2 t t2 a b]
ys
        Info
_ -> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (UniquenessG1T2 t t2 a b -> [Char])
-> UniquenessG1T2 t t2 a b
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show(Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 t t2 a b -> IO ())
-> UniquenessG1T2 t t2 a b -> IO ()
forall a b. (a -> b) -> a -> b
$ UniquenessG1T2 t t2 a b
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
forall (t :: * -> *) a b (t2 :: * -> *).
(Show (t a), Show b, Show (t2 b)) =>
Info2 -> [UniquenessG1T2 t t2 a b] -> IO ()
printUniquenessG1List Info2
info [UniquenessG1T2 t t2 a b]
ys  -- the most verbose output
  | Bool
otherwise =
      case (\(I2 InfoFile
x) -> InfoFile
x) Info2
info of
        Af [Char]
_ -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Bf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (t a -> [Char]
forall a. Show a => a -> [Char]
show (t a -> [Char])
-> (UniquenessG1T2 t t2 a b -> t a)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ (UniquenessG1T2 t t2 a b
yUniquenessG1T2 t t2 a b
-> [UniquenessG1T2 t t2 a b] -> [UniquenessG1T2 t t2 a b]
forall a. a -> [a] -> [a]
:[UniquenessG1T2 t t2 a b]
ys)
        Cf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 t t2 a b -> t2 b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ (UniquenessG1T2 t t2 a b
yUniquenessG1T2 t t2 a b
-> [UniquenessG1T2 t t2 a b] -> [UniquenessG1T2 t t2 a b]
forall a. a -> [a] -> [a]
:[UniquenessG1T2 t t2 a b]
ys)
        Df [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ (UniquenessG1T2 t t2 a b
yUniquenessG1T2 t t2 a b
-> [UniquenessG1T2 t t2 a b] -> [UniquenessG1T2 t t2 a b]
forall a. a -> [a] -> [a]
:[UniquenessG1T2 t t2 a b]
ys)
        Ef [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\UniquenessG1T2 t t2 a b
t -> (t a -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 t t2 a b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 t t2 a b
t))) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ [UniquenessG1T2 t t2 a b]
ys
        Ff [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\UniquenessG1T2 t t2 a b
t -> (t a -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 t t2 a b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
t))) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ [UniquenessG1T2 t t2 a b]
ys
        Gf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\UniquenessG1T2 t t2 a b
t -> (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 t t2 a b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
t))) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ [UniquenessG1T2 t t2 a b]
ys
        ~(Hf [Char]
xs) -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> ([UniquenessG1T2 t t2 a b] -> [[Char]])
-> [UniquenessG1T2 t t2 a b]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 t t2 a b -> [Char])
-> [UniquenessG1T2 t t2 a b] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\UniquenessG1T2 t t2 a b
t -> (t a -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> t a
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 t t2 a b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 t t2 a b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
t))) ([UniquenessG1T2 t t2 a b] -> IO ())
-> [UniquenessG1T2 t t2 a b] -> IO ()
forall a b. (a -> b) -> a -> b
$ [UniquenessG1T2 t t2 a b]
ys  -- the most verbose output
printUniquenessG1List Info2
_ [UniquenessG1T2 t t2 a b]
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | A variant of the 'printUniquenessG1List' where @a@ is 'Char' so that the inner third arguments in the triples are 'String's.
printUniquenessG1ListStr
  :: (Show b, Show (t2 b)) => Info2 -- ^ A parameter to control the predefined behaviour of the printing. The 'I1' branch prints to the 'stdout' and the 'I2' - to the file.
  -> VB.Vector (UniquenessG1T2 [] t2 Char b) -- ^ The 'VB.Vector' of elements, for which the information is printed.
  -> IO ()
printUniquenessG1ListStr :: Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
printUniquenessG1ListStr Info2
info Vector (UniquenessG1T2 [] t2 Char b)
v
  | Vector (UniquenessG1T2 [] t2 Char b) -> Bool
forall a. Vector a -> Bool
VB.null Vector (UniquenessG1T2 [] t2 Char b)
v = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Info2 -> Bool
forall a b. InfoG a b -> Bool
isI1 Info2
info =
      case (\(I1 Info
x) -> Info
x) Info2
info of
        Info
A -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Info
B -> ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ [Char] -> IO ()
putStrLn (Vector [Char] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Info
C -> ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ [Char] -> IO ()
putStrLn (Vector [Char] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 [] t2 Char b -> t2 b)
-> UniquenessG1T2 [] t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Info
D -> ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ [Char] -> IO ()
putStrLn (Vector [Char] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 [] t2 Char b -> Vector b)
-> UniquenessG1T2 [] t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Info
E -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 [] t2 Char b -> [Char])
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char]) -> (Int -> t2 b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 [] t2 Char b -> t2 b)
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> t2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
printUniquenessG1ListStr Info2
info (Vector (UniquenessG1T2 [] t2 Char b)
-> Vector (UniquenessG1T2 [] t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 [] t2 Char b)
v)
        Info
F -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 [] t2 Char b -> [Char])
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char]) -> (Int -> Vector b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 [] t2 Char b -> Vector b)
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
printUniquenessG1ListStr Info2
info (Vector (UniquenessG1T2 [] t2 Char b)
-> Vector (UniquenessG1T2 [] t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 [] t2 Char b)
v)
        Info
G -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char]) -> (Int -> t2 b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 [] t2 Char b -> t2 b)
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> t2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char]) -> (Int -> Vector b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 [] t2 Char b -> Vector b)
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
printUniquenessG1ListStr Info2
info (Vector (UniquenessG1T2 [] t2 Char b)
-> Vector (UniquenessG1T2 [] t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 [] t2 Char b)
v)
        Info
_ -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 [] t2 Char b -> [Char])
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char]) -> (Int -> t2 b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 [] t2 Char b -> t2 b)
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> t2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show(Vector b -> [Char]) -> (Int -> Vector b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 [] t2 Char b -> Vector b)
-> (Int -> UniquenessG1T2 [] t2 Char b) -> Int -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 [] t2 Char b)
-> Int -> UniquenessG1T2 [] t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 [] t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
printUniquenessG1ListStr Info2
info (Vector (UniquenessG1T2 [] t2 Char b)
-> Vector (UniquenessG1T2 [] t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 [] t2 Char b)
v)  -- the most verbose output
  | Bool
otherwise =
      case (\(I2 InfoFile
x) -> InfoFile
x) Info2
info of
        Af [Char]
_ -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Bf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Cf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 [] t2 Char b -> t2 b)
-> UniquenessG1T2 [] t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Df [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 [] t2 Char b -> Vector b)
-> UniquenessG1T2 [] t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Ef [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 [] t2 Char b
t -> (UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 [] t2 Char b
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 [] t2 Char b
t))) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Ff [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 [] t2 Char b
t -> (UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 [] t2 Char b
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 [] t2 Char b
t))) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        Gf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 [] t2 Char b
t -> (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 [] t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 [] t2 Char b
t))) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v
        ~(Hf [Char]
xs) -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 [] t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 [] t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 [] t2 Char b -> [Char])
-> Vector (UniquenessG1T2 [] t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 [] t2 Char b
t -> (UniquenessG1T2 [] t2 Char b -> [Char]
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 [] t2 Char b
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 [] t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 [] t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 [] t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 [] t2 Char b
t))) (Vector (UniquenessG1T2 [] t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 [] t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 [] t2 Char b)
v  -- the most verbose output

-- | A variant of the 'printUniquenessG1List' where @a@ is 'Char' so that the inner third arguments in the triples are 'VB.Vector' of 'Char'.
printUniquenessG1VChar
  :: (Show b, Show (t2 b)) => Info2 -- ^ A parameter to control the predefined behaviour of the printing. The 'I1' branch prints to the 'stdout' and the 'I2' - to the file.
  -> VB.Vector (UniquenessG1T2 VB.Vector t2 Char b) -- ^ The 'VB.Vector' of elements, for which the information is printed.
  -> IO ()
printUniquenessG1VChar :: Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
printUniquenessG1VChar Info2
info Vector (UniquenessG1T2 Vector t2 Char b)
v
  | Vector (UniquenessG1T2 Vector t2 Char b) -> Bool
forall a. Vector a -> Bool
VB.null Vector (UniquenessG1T2 Vector t2 Char b)
v = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Info2 -> Bool
forall a b. InfoG a b -> Bool
isI1 Info2
info =
      case (\(I1 Info
x) -> Info
x) Info2
info of
        Info
A -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Info
B -> (Vector Char -> IO ()) -> Vector (Vector Char) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> (Vector Char -> [Char]) -> Vector Char -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList) (Vector (Vector Char) -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b)
    -> Vector (Vector Char))
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> Vector Char)
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector (Vector Char)
forall a b. (a -> b) -> Vector a -> Vector b
VB.map UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Info
C -> ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ [Char] -> IO ()
putStrLn (Vector [Char] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 Vector t2 Char b -> t2 b)
-> UniquenessG1T2 Vector t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Info
D -> ([Char] -> IO ()) -> Vector [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ [Char] -> IO ()
putStrLn (Vector [Char] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 Vector t2 Char b -> Vector b)
-> UniquenessG1T2 Vector t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Info
E -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (Vector Char -> [Char]) -> (Int -> Vector Char) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 Vector t2 Char b -> Vector Char)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char]) -> (Int -> t2 b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 Vector t2 Char b -> t2 b)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> t2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
printUniquenessG1VChar Info2
info (Vector (UniquenessG1T2 Vector t2 Char b)
-> Vector (UniquenessG1T2 Vector t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 Vector t2 Char b)
v)
        Info
F -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (Vector Char -> [Char]) -> (Int -> Vector Char) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 Vector t2 Char b -> Vector Char)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char]) -> (Int -> Vector b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 Vector t2 Char b -> Vector b)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
printUniquenessG1VChar Info2
info (Vector (UniquenessG1T2 Vector t2 Char b)
-> Vector (UniquenessG1T2 Vector t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 Vector t2 Char b)
v)
        Info
G -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char]) -> (Int -> t2 b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 Vector t2 Char b -> t2 b)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> t2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char]) -> (Int -> Vector b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 Vector t2 Char b -> Vector b)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
printUniquenessG1VChar Info2
info (Vector (UniquenessG1T2 Vector t2 Char b)
-> Vector (UniquenessG1T2 Vector t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 Vector t2 Char b)
v)
        Info
_ -> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (Vector Char -> [Char]) -> (Int -> Vector Char) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 (UniquenessG1T2 Vector t2 Char b -> Vector Char)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char]) -> (Int -> t2 b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 (UniquenessG1T2 Vector t2 Char b -> t2 b)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> t2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Int -> [Char]) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector b -> [Char]
forall a. Show a => a -> [Char]
show(Vector b -> [Char]) -> (Int -> Vector b) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 (UniquenessG1T2 Vector t2 Char b -> Vector b)
-> (Int -> UniquenessG1T2 Vector t2 Char b) -> Int -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (UniquenessG1T2 Vector t2 Char b)
-> Int -> UniquenessG1T2 Vector t2 Char b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector (UniquenessG1T2 Vector t2 Char b)
v (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
0) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall b (t2 :: * -> *).
(Show b, Show (t2 b)) =>
Info2 -> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
printUniquenessG1VChar Info2
info (Vector (UniquenessG1T2 Vector t2 Char b)
-> Vector (UniquenessG1T2 Vector t2 Char b)
forall a. Vector a -> Vector a
VB.unsafeTail Vector (UniquenessG1T2 Vector t2 Char b)
v)  -- the most verbose output
  | Bool
otherwise =
      case (\(I2 InfoFile
x) -> InfoFile
x) Info2
info of
        Af [Char]
_ -> [Char] -> IO ()
putStr [Char]
"" -- nothing is printed
        Bf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (Vector Char -> [Char])
-> (UniquenessG1T2 Vector t2 Char b -> Vector Char)
-> UniquenessG1T2 Vector t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Cf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (t2 b -> [Char])
-> (UniquenessG1T2 Vector t2 Char b -> t2 b)
-> UniquenessG1T2 Vector t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Df [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (Vector b -> [Char]
forall a. Show a => a -> [Char]
show (Vector b -> [Char])
-> (UniquenessG1T2 Vector t2 Char b -> Vector b)
-> UniquenessG1T2 Vector t2 Char b
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Ef [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 Vector t2 Char b
t -> (Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 Vector t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 Vector t2 Char b
t))) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Ff [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 Vector t2 Char b
t -> (Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 Vector t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 Vector t2 Char b
t))) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        Gf [Char]
xs -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 Vector t2 Char b
t -> (t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 Vector t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 Vector t2 Char b
t))) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v
        ~(Hf [Char]
xs) -> [Char] -> [[Char]] -> IO ()
forall (t :: * -> *) a.
(Foldable t, Show (t a), Monoid (t a)) =>
[Char] -> t (t a) -> IO ()
toFile [Char]
xs ([[Char]] -> IO ())
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> [[Char]])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Char] -> [[Char]]
forall a. Vector a -> [a]
VB.toList (Vector [Char] -> [[Char]])
-> (Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b)
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniquenessG1T2 Vector t2 Char b -> [Char])
-> Vector (UniquenessG1T2 Vector t2 Char b) -> Vector [Char]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\UniquenessG1T2 Vector t2 Char b
t -> (Vector Char -> [Char]
forall a. Vector a -> [a]
VB.toList (UniquenessG1T2 Vector t2 Char b -> Vector Char
forall a b c. (a, b, c) -> c
lastFrom3 UniquenessG1T2 Vector t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t2 b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 Vector t2 Char b -> t2 b
forall a b c. (a, b, c) -> a
firstFrom3 UniquenessG1T2 Vector t2 Char b
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
newLineEnding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Vector b -> [Char]
forall a. Show a => a -> [Char]
show (UniquenessG1T2 Vector t2 Char b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 Vector t2 Char b
t))) (Vector (UniquenessG1T2 Vector t2 Char b) -> IO ())
-> Vector (UniquenessG1T2 Vector t2 Char b) -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector (UniquenessG1T2 Vector t2 Char b)
v  -- the most verbose output

-- | Auxiliary printing function to define the line ending in some cases.
newLineEnding :: String
newLineEnding :: [Char]
newLineEnding
  | Newline
nativeNewline Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
LF = [Char]
"\n"
  | Bool
otherwise = [Char]
"\r\n"

-- | Variant of the 'maximumElBy' function where all the given \"properties\" are used.
-- The predefined library \"properties\" or related to them functions can be found in the package @uniqueness-periods-vector-properties@.
maximumElByAll ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  ->  UniqG2T2 t t2 a b -- ^ The data to be analyzed.
  -> UniquenessG1T2 t t2 a b -- ^ The maximum element according to the given \"properties\".
maximumElByAll :: Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniquenessG1T2 t t2 a b
maximumElByAll Vector (t2 b -> b)
vN = Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
maximumElBy (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Vector (t2 b -> b)
vN
{-# INLINE maximumElByAll #-}

-- | The function evaluates
-- the generated 'VB.Vector' of 'UniquenessG1T2' @t@ @t2@ @a@ @b@ elements to retrieve the possibly maximum element in it with respect to the order and significance (principality)
-- of the \"properties\" being evaluated. The most significant and principal is the \"property\", which index in the 'VB.Vector' of them is the 'Int' argument of the function
-- minus 1, then less significant is the next to the left \"property\" and so on.
maximumElGBy ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, UGG1 t (PreApp t a) a, Ord b, Show a, Show b) => t a -- ^ The \"whitespace symbols\" that delimit the subs in the 'Foldable' structure to be processed.
  -> a -- ^ The first \"whitespace symbol\" from the left.
  -> PreApp t a -- ^ A parameter to specify the lists to be prepended and postpended to the given data to be processed before actual processment.
  -> (t a -> VB.Vector a) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of @a@ so that the function can process further the permutations
  -> ((t (t a)) -> VB.Vector (VB.Vector a)) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of 'VB.Vector' of @a@ so that the function can process further
  -> (VB.Vector a -> t a) -- ^ The function that is used internally to convert from the boxed 'VB.Vector' of @a@ so that the function can process further
  -> VB.Vector (VB.Vector Int) -- ^ The list of permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).
  -> Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> FuncRep (t a) (VB.Vector c) (t2 b) -- ^ It includes the defined earlier variant with data constructor 'D2', but additionally allows to use just single argument with data constructor 'U1'
  -> t a -- ^ The data to be processed.
  -> UniquenessG1T2 t t2 a b
maximumElGBy :: t a
-> a
-> PreApp t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Int
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> UniquenessG1T2 t t2 a b
maximumElGBy t a
whspss a
hd PreApp t a
rr t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Int
k Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep t a
v
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = [Char] -> UniquenessG1T2 t t2 a b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.General.DebugG.maximumElGBy: undefined for that amount of norms. "
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
   let vM :: Vector (UniquenessG1T2 t t2 a b)
vM = t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) b (t2 :: * -> *) c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Ord b, Foldable t2) =>
t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (t2 b, Vector b, t a)
uniquenessVariants2GNPB (PreApp t a -> t a
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get1m PreApp t a
rr) (PreApp t a -> t a
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get2m PreApp t a
rr) a
hd t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> t a -> t (t a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG t a
whspss t a
v)
       maxK :: UniquenessG1T2 t t2 a b
maxK = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Vector (UniquenessG1T2 t t2 a b)
vM
       vK :: Vector (UniquenessG1T2 t t2 a b)
vK = (UniquenessG1T2 t t2 a b -> Bool)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\(t2 b
_,Vector b
vN2,t a
_) -> Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
maxK) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Vector (UniquenessG1T2 t t2 a b)
vM in
         Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
maximumElBy (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int -> Vector (t2 b -> b) -> Vector (t2 b -> b)
forall a. Int -> Int -> Vector a -> Vector a
VB.unsafeSlice Int
0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector (t2 b -> b)
vN) ((Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
forall a b. (Vector a, b) -> UniquenessG2 a b
UL2 (Vector (UniquenessG1T2 t t2 a b)
forall a. Vector a
VB.empty,Vector (UniquenessG1T2 t t2 a b)
vK))
 | Bool
otherwise = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 Int
0) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 Int
0)) (Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b)
-> (t a -> Vector (UniquenessG1T2 t t2 a b))
-> t a
-> UniquenessG1T2 t t2 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> PreApp t a
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) (t2 :: * -> *) b c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
a
-> t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> PreApp t a
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> Vector (UniquenessG1T2 t t2 a b)
uniquenessVariantsGN a
hd t a
whspss t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms PreApp t a
rr Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> UniquenessG1T2 t t2 a b) -> t a -> UniquenessG1T2 t t2 a b
forall a b. (a -> b) -> a -> b
$ t a
v

-- | A variant for 'uniquenessVariants2GNB' and 'uniquenessVariants2GNPB' with the second argument defining, which one is used.
uniquenessVariantsGN ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => a -- ^ The first from the left element inthe \"whitespace symbols\" 'Foldable' structure.
  -> t a -- ^ A list of \"whitespace symbols\" that delimits the subGs in the structure to be processed.
  -> (t a -> VB.Vector a) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of @a@ so that the function can process further the permutations
  -> ((t (t a)) -> VB.Vector (VB.Vector a)) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of 'VB.Vector' of @a@ so that the function can process further
  -> (VB.Vector a -> t a) -- ^ The function that is used internally to convert from the boxed 'VB.Vector' of @a@ so that the function can process further
  -> VB.Vector (VB.Vector Int) -- ^ The list of permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).
  -> PreApp t a -- ^ A parameter to specify the lists to be prepended and postpended to the given data to be processed before actual processment.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> FuncRep (t a) (VB.Vector c) (t2 b) -- ^ It includes the defined earlier variant with data constructor 'D2', but additionally allows to use just single argument with data constructor 'U1'
  -> t a -- ^ The data to be processed.
  -> VB.Vector (UniquenessG1T2 t t2 a b)
uniquenessVariantsGN :: a
-> t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> PreApp t a
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> Vector (UniquenessG1T2 t t2 a b)
uniquenessVariantsGN a
hd t a
whspss t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms (PA t a
ts t a
us) Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep t a
data1 = t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) b (t2 :: * -> *) c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Ord b, Foldable t2) =>
t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (t2 b, Vector b, t a)
uniquenessVariants2GNPB t a
ts t a
us a
hd t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> t a -> t (t a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG t a
whspss t a
data1)
uniquenessVariantsGN a
hd t a
whspss t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms PreApp t a
K Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep t a
data1 = a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) b (t2 :: * -> *) c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Ord b, Foldable t2) =>
a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (t2 b, Vector b, t a)
uniquenessVariants2GNB a
hd t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> t a -> t (t a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG t a
whspss t a
data1)
{-# INLINE uniquenessVariantsGN #-}

-- | Rearranges the last argument.
-- Finds out the group of maximum elements with respect of the @k@ \"properties\" (the most significant of which is the rightest one,
-- then to the left less significant etc.) of the second argument. The number of \"properties\" is given as the first argument. Then the function
-- rearranges the last argument by moving the elements equal by the second element in the triple to the maximum element to the first element in
-- the resulting tuple. The elements that are not equal to the maximum one are moved to the second element in the tuple.
-- If the second element of the tuple is empty, then just returns the last argument.
--
-- The last by significance \"property\" is the first element in the 'VB.Vector' of \"properties\" (@[b] -> b@) (so that the order of significance is
-- from the right to the left in the respective 'VB.Vector'). If the length of the vector of properties is greater than the first argument then
-- the last element(s) in the vector do not participate in producing the result (are ignored).
maximumElByVec ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> UniqG2T2 t t2 a b -- ^ The data to be analyzed.
  -> UniqG2T2 t t2 a b
maximumElByVec :: Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
maximumElByVec Int
k Vector (t2 b -> b)
vN UniqG2T2 t t2 a b
x
 | Vector (UniquenessG1T2 t t2 a b) -> Bool
forall a. Vector a -> Bool
VB.null (Vector (UniquenessG1T2 t t2 a b) -> Bool)
-> (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> b
snd ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> Bool) -> UniqG2T2 t t2 a b -> Bool
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
x = UniqG2T2 t t2 a b
x
 | Bool
otherwise = let !uniq :: UniquenessG1T2 t t2 a b
uniq = Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniquenessG1T2 t t2 a b
maximumElBy Int
k Vector (t2 b -> b)
vN UniqG2T2 t t2 a b
x in let !snD :: Vector b
snD = UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
uniq in (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
forall a b. (Vector a, b) -> UniquenessG2 a b
UL2 ((\(!Vector (UniquenessG1T2 t t2 a b)
v1,!Vector (UniquenessG1T2 t t2 a b)
v2) -> (((Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> a
fst ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
x) Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a. Monoid a => a -> a -> a
`mappend` Vector (UniquenessG1T2 t t2 a b)
v1,Vector (UniquenessG1T2 t t2 a b)
v2)) ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> (Vector (UniquenessG1T2 t t2 a b),
     Vector (UniquenessG1T2 t t2 a b)))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (UniquenessG1T2 t t2 a b -> Bool)
-> Vector (UniquenessG1T2 t t2 a b)
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
VB.unstablePartition (Vector b -> Vector b -> Bool
forall b. Ord b => Vector b -> Vector b -> Bool
equalSnDs Vector b
snD (Vector b -> Bool)
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) (Vector (UniquenessG1T2 t t2 a b)
 -> (Vector (UniquenessG1T2 t t2 a b),
     Vector (UniquenessG1T2 t t2 a b)))
-> (UniqG2T2 t t2 a b -> Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> Vector (UniquenessG1T2 t t2 a b)
forall a b. (a, b) -> b
snd ((Vector (UniquenessG1T2 t t2 a b),
  Vector (UniquenessG1T2 t t2 a b))
 -> Vector (UniquenessG1T2 t t2 a b))
-> (UniqG2T2 t t2 a b
    -> (Vector (UniquenessG1T2 t t2 a b),
        Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> Vector (UniquenessG1T2 t t2 a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall (t :: * -> *) (t2 :: * -> *) a b.
UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UniqG2T2 t t2 a b
 -> (Vector (UniquenessG1T2 t t2 a b),
     Vector (UniquenessG1T2 t t2 a b)))
-> UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
x)
{-# NOINLINE maximumElByVec #-}

equalSnDs
  :: Ord b => VB.Vector b
  -> VB.Vector b
  -> Bool
equalSnDs :: Vector b -> Vector b -> Bool
equalSnDs Vector b
v1 Vector b
v2
 | Vector b -> Bool
forall a. Vector a -> Bool
VB.null Vector b
v1 = Vector b -> Bool
forall a. Vector a -> Bool
VB.null Vector b
v2
 | Vector b -> Bool
forall a. Vector a -> Bool
VB.null Vector b
v2 = Bool
False
 | Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
v1 Int
0 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
v2 Int
0 = Vector b -> Vector b -> Bool
forall b. Ord b => Vector b -> Vector b -> Bool
equalSnDs (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
VB.unsafeSlice Int
1 (Vector b -> Int
forall a. Vector a -> Int
VB.length Vector b
v1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector b
v1) (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
VB.unsafeSlice Int
1 (Vector b -> Int
forall a. Vector a -> Int
VB.length Vector b
v2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector b
v2)
 | Bool
otherwise = Bool
False

-- | A variant of the 'maximumElByVec' where all the given \"properties\" are used.
maximumElByVecAll ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> UniqG2T2 t t2 a b -- ^ The data to be analyzed.
  -> UniqG2T2 t t2 a b
maximumElByVecAll :: Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
maximumElByVecAll Vector (t2 b -> b)
vN = Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
maximumElByVec (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Vector (t2 b -> b)
vN
{-# INLINE maximumElByVecAll #-}

-- |  Finds out the @n@ (the first 'Int' argument) consequential maximum elements, and then rearranges the input moving the elements equal by the first element
-- in the triple to the maximum element to the first element in the tuple.
uniqNPropertiesN ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => Int -- ^ A quantity of the recursive calls that returns each one a new resulting group from the rest of the data processed.
  -> Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> UniqG2T2 t t2 a b -- ^ The data to be analyzed.
  -> UniqG2T2 t t2 a b
uniqNPropertiesN :: Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
uniqNPropertiesN Int
n Int
k Vector (t2 b -> b)
vN UniqG2T2 t t2 a b
y
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = UniqG2T2 t t2 a b
y
 | Bool
otherwise = Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
uniqNPropertiesN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
k Vector (t2 b -> b)
vN (UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b)
-> (UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
maximumElByVec Int
k Vector (t2 b -> b)
vN (UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b)
-> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
forall a b. (a -> b) -> a -> b
$ UniqG2T2 t t2 a b
y
{-# NOINLINE uniqNPropertiesN #-}

-- | A variant of the 'uniqNPropertiesN' where all the given \"properties\" are used.
uniqNPropertiesNAll ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => Int -- ^ A quantity of the recursive calls that returns each one a new resulting group from the rest of the data processed.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> UniqG2T2 t t2 a b -- ^ The data to be analyzed.
  -> UniqG2T2 t t2 a b
uniqNPropertiesNAll :: Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
uniqNPropertiesNAll Int
n Vector (t2 b -> b)
vN = Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
uniqNPropertiesN Int
n (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Vector (t2 b -> b)
vN
{-# INLINE uniqNPropertiesNAll #-}

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

-- | The full analyzing and processment function.
uniqNProperties2GN ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, UGG1 t (PreApp t a) a, Ord b, Show a, Show b) => a -- ^ The first most common element in the whitespace symbols structure
  -> t a -- ^ A list of \"whitespace symbols\" that delimits the sublists in the list to be processed.
  -> (t a -> VB.Vector a) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of @a@ so that the function can process further the permutations
  -> ((t (t a)) -> VB.Vector (VB.Vector a)) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of 'VB.Vector' of @a@ so that the function can process further
  -> (VB.Vector a -> t a) -- ^ The function that is used internally to convert from the boxed 'VB.Vector' of @a@ so that the function can process further
  -> VB.Vector (VB.Vector Int) -- ^ The list of permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).
  -> PreApp t a -- ^ A parameter to specify the lists to be prepended and postpended to the given data to be processed before actual processment.
  -> Int -- ^ A quantity of the recursive calls that returns each one a new resulting group from the rest of the data processed.
  -> Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> FuncRep (t a) (VB.Vector c) (t2 b) -- ^ It includes the defined earlier variant with data constructor 'D2', but additionally allows to use just single argument with data constructor 'U1'
  -> t a -- ^ The data to be processed.
  -> UniqG2T2 t t2 a b
uniqNProperties2GN :: a
-> t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> PreApp t a
-> Int
-> Int
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> UniqG2T2 t t2 a b
uniqNProperties2GN a
hd t a
whspss t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms PreApp t a
rr Int
n Int
k Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep t a
v
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
forall a b. (Vector a, b) -> UniquenessG2 a b
UL2 (Vector (UniquenessG1T2 t t2 a b)
forall a. Vector a
VB.empty,Vector (UniquenessG1T2 t t2 a b)
forall a. Vector a
VB.empty)
 | Bool
otherwise = let v1 :: Vector (UniquenessG1T2 t t2 a b)
v1 = t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) b (t2 :: * -> *) c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Ord b, Foldable t2) =>
t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (t2 b, Vector b, t a)
uniquenessVariants2GNPB (PreApp t a -> t a
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get1m PreApp t a
rr) (PreApp t a -> t a
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get2m PreApp t a
rr) a
hd t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> t a -> t (t a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG t a
whspss t a
v) in Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int
-> Int
-> Vector (t2 b -> b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
uniqNPropertiesN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
k Vector (t2 b -> b)
vN (UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b)
-> (UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b)
-> UniqG2T2 t t2 a b
-> UniqG2T2 t t2 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int -> Vector (t2 b -> b) -> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
maximumElByVec Int
k Vector (t2 b -> b)
vN (UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b)
-> UniqG2T2 t t2 a b -> UniqG2T2 t t2 a b
forall a b. (a -> b) -> a -> b
$ ((Vector (UniquenessG1T2 t t2 a b),
 Vector (UniquenessG1T2 t t2 a b))
-> UniqG2T2 t t2 a b
forall a b. (Vector a, b) -> UniquenessG2 a b
UL2 (Vector (UniquenessG1T2 t t2 a b)
forall a. Vector a
VB.empty,Vector (UniquenessG1T2 t t2 a b)
v1))