-- |
-- Module      :  Languages.UniquenessPeriods.Vector.DataG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Is a generalization of the DobutokO.Poetry.Data module
-- functionality from the @dobutokO-poetry-general@ package.
--

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

module Languages.UniquenessPeriods.Vector.DataG where

import qualified Data.Vector as VB
import Data.SubG

instance (Eq a) => InsertLeft VB.Vector a where
  %@ :: a -> Vector a -> Vector a
(%@) = a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
VB.cons
  %^ :: Vector a -> Vector (Vector a) -> Vector (Vector a)
(%^) = Vector a -> Vector (Vector a) -> Vector (Vector a)
forall a. a -> Vector a -> Vector a
VB.cons

type UniquenessG1T2 t t2 a b = (t2 b,VB.Vector b, t a)

-- | The list in the 'PA' variant represent the prepending @[a]@ and the postpending one respectively. 'K' constuctor actually means no prepending and
-- postpending (usually of the text). Are used basically to control the behaviour of the functions.
data PreApp t a = K | PA (t a) (t a) deriving PreApp t a -> PreApp t a -> Bool
(PreApp t a -> PreApp t a -> Bool)
-> (PreApp t a -> PreApp t a -> Bool) -> Eq (PreApp t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: * -> *) a.
Eq (t a) =>
PreApp t a -> PreApp t a -> Bool
/= :: PreApp t a -> PreApp t a -> Bool
$c/= :: forall (t :: * -> *) a.
Eq (t a) =>
PreApp t a -> PreApp t a -> Bool
== :: PreApp t a -> PreApp t a -> Bool
$c== :: forall (t :: * -> *) a.
Eq (t a) =>
PreApp t a -> PreApp t a -> Bool
Eq

class (Foldable t) => UGG1 t a b where
  get1m :: a -> t b
  get2m :: a -> t b
  getm :: Bool -> a -> t b
  getm Bool
True = a -> t b
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get1m
  getm Bool
_ = a -> t b
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get2m
  preapp :: a -> t (t b) -> t (t b)
  setm :: t b -> t b -> a

instance Eq a => UGG1 [] (PreApp [] a) a where
  get1m :: PreApp [] a -> [a]
get1m PreApp [] a
K = []
  get1m (PA [a]
xs [a]
_) = [a]
xs
  get2m :: PreApp [] a -> [a]
get2m PreApp [] a
K = []
  get2m (PA [a]
_ [a]
ys) = [a]
ys
  preapp :: PreApp [] a -> [[a]] -> [[a]]
preapp PreApp [] a
K [[a]]
xss = [[a]]
xss
  preapp (PA [a]
xs [a]
ys) [[a]]
yss = [a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
yss [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
ys]
  setm :: [a] -> [a] -> PreApp [] a
setm [] [] = PreApp [] a
forall (t :: * -> *) a. PreApp t a
K
  setm [a]
xs [a]
ys = [a] -> [a] -> PreApp [] a
forall (t :: * -> *) a. t a -> t a -> PreApp t a
PA [a]
xs [a]
ys

instance Eq a => UGG1 VB.Vector (PreApp VB.Vector a) a where
  get1m :: PreApp Vector a -> Vector a
get1m PreApp Vector a
K = Vector a
forall a. Vector a
VB.empty
  get1m (PA Vector a
v Vector a
_) = Vector a
v
  get2m :: PreApp Vector a -> Vector a
get2m PreApp Vector a
K = Vector a
forall a. Vector a
VB.empty
  get2m (PA Vector a
_ Vector a
v) = Vector a
v
  preapp :: PreApp Vector a -> Vector (Vector a) -> Vector (Vector a)
preapp PreApp Vector a
K Vector (Vector a)
v = Vector (Vector a)
v
  preapp (PA Vector a
v1 Vector a
v2) Vector (Vector a)
v3 = Vector a
-> Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t (t a))) =>
t a -> t (t a) -> t (t a) -> t (t a)
preAppend Vector a
v1 (Vector a -> Vector (Vector a)
forall a. a -> Vector a
VB.singleton Vector a
v2) Vector (Vector a)
v3
  setm :: Vector a -> Vector a -> PreApp Vector a
setm Vector a
v1 Vector a
v2
    | Vector a -> Bool
forall a. Vector a -> Bool
VB.null Vector a
v1 Bool -> Bool -> Bool
&& Vector a -> Bool
forall a. Vector a -> Bool
VB.null Vector a
v2 = PreApp Vector a
forall (t :: * -> *) a. PreApp t a
K
    | Bool
otherwise = Vector a -> Vector a -> PreApp Vector a
forall (t :: * -> *) a. t a -> t a -> PreApp t a
PA Vector a
v1 Vector a
v2

isPA :: PreApp t a -> Bool
isPA :: PreApp t a -> Bool
isPA PreApp t a
K = Bool
False
isPA PreApp t a
_ = Bool
True

isK :: PreApp t a -> Bool
isK :: PreApp t a -> Bool
isK PreApp t a
K = Bool
True
isK PreApp t a
_ = Bool
False

data UniquenessG2 a b = UL2 (VB.Vector a,b) deriving UniquenessG2 a b -> UniquenessG2 a b -> Bool
(UniquenessG2 a b -> UniquenessG2 a b -> Bool)
-> (UniquenessG2 a b -> UniquenessG2 a b -> Bool)
-> Eq (UniquenessG2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
UniquenessG2 a b -> UniquenessG2 a b -> Bool
/= :: UniquenessG2 a b -> UniquenessG2 a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
UniquenessG2 a b -> UniquenessG2 a b -> Bool
== :: UniquenessG2 a b -> UniquenessG2 a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
UniquenessG2 a b -> UniquenessG2 a b -> Bool
Eq

instance (Show a, Show b, InsertLeft t a, Foldable t2, Show (t2 b), Show (t a)) => Show (UniquenessG2 (UniquenessG1T2 t t2 a b) (VB.Vector (UniquenessG1T2 t t2 a b))) where
  show :: UniquenessG2
  (UniquenessG1T2 t t2 a b) (Vector (UniquenessG1T2 t t2 a b))
-> String
show (UL2 (Vector (UniquenessG1T2 t t2 a b)
ws,Vector (UniquenessG1T2 t t2 a b)
_)) = Vector (UniquenessG1T2 t t2 a b) -> String
forall a. Show a => a -> String
show Vector (UniquenessG1T2 t t2 a b)
ws

type UniqG2T2 t t2 a b = UniquenessG2 (UniquenessG1T2 t t2 a b) (VB.Vector (UniquenessG1T2 t t2 a b))

get22 :: UniqG2T2 t t2 a b -> (VB.Vector (UniquenessG1T2 t t2 a b), VB.Vector (UniquenessG1T2 t t2 a b))
get22 :: UniqG2T2 t t2 a b
-> (Vector (UniquenessG1T2 t t2 a b),
    Vector (UniquenessG1T2 t t2 a b))
get22 (UL2 (Vector (UniquenessG1T2 t t2 a b)
ws, Vector (UniquenessG1T2 t t2 a b)
x)) = (Vector (UniquenessG1T2 t t2 a b)
ws, Vector (UniquenessG1T2 t t2 a b)
x)

-- | Is used to avoid significant code duplication.
data FuncRep a b c = U1 (a -> c) | D2 (a -> b) (b -> c)

getAC :: FuncRep a b c -> (a -> c)
getAC :: FuncRep a b c -> a -> c
getAC (U1 a -> c
f) = a -> c
f
getAC (D2 a -> b
g1 b -> c
g2) = b -> c
g2 (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g1

isU1 :: FuncRep a b c -> Bool
isU1 :: FuncRep a b c -> Bool
isU1 (U1 a -> c
_) = Bool
True
isU1 FuncRep a b c
_ = Bool
False

isD2 :: FuncRep a b c -> Bool
isD2 :: FuncRep a b c -> Bool
isD2 (D2 a -> b
_ b -> c
_) = Bool
True
isD2 FuncRep a b c
_ = Bool
False