{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK show-extensions #-}

{- |
Module      :  Aftovolio.StrictVG
Copyright   :  (c) Oleksandr Zhabenko 2020-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com

Simplified version of the @phonetic-languages-common@ package.
Uses less dependencies.
-}
module Aftovolio.StrictVG (
    -- * Working with lists
    uniquenessVariants2GNBL,
    uniquenessVariants2GNPBL,
) where

import Aftovolio.PermutationsArr
import qualified Data.Foldable as F
import Data.InsertLeft (InsertLeft (..))
import GHC.Arr
import GHC.Base
import GHC.Num ((-))

uniquenessVariants2GNBL ::
    (Eq a, F.Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
    -- | The first most common element in the \"whitespace symbols\" structure
    a ->
    -- | The function that is used internally to convert to the @[a]@ so that the function can process further the permutations
    (t a -> [a]) ->
    -- | The function that is used internally to convert to the @[[a]]@ so that the function can process further
    ((t (t a)) -> [[a]]) ->
    -- | The function that is used internally to convert to the needed representation so that the function can process further
    ([a] -> t a) ->
    -- | The permutations of 'Int' indices starting from 0 and up to n (n is probably less than 8).
    [Array Int Int] ->
    -- | Must be obtained as 'subG' @whspss xs@ or in equivalent way
    t (t a) ->
    [t a]
uniquenessVariants2GNBL :: forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL !a
hd t a -> [a]
f1 t (t a) -> [[a]]
f2 [a] -> t a
f3 [Array Int Int]
perms !t (t a)
subs = t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL t a
forall a. Monoid a => a
mempty t a
forall a. Monoid a => a
mempty a
hd t a -> [a]
f1 t (t a) -> [[a]]
f2 [a] -> t a
f3 [Array Int Int]
perms t (t a)
subs
{-# INLINE uniquenessVariants2GNBL #-}
{-# SPECIALIZE uniquenessVariants2GNBL ::
    Char ->
    (String -> String) ->
    ([String] -> [String]) ->
    (String -> String) ->
    [Array Int Int] ->
    [String] ->
    [String]
    #-}

uniquenessVariants2GNPBL ::
    (Eq a, F.Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
    t a ->
    t a ->
    -- | The first most common element in the whitespace symbols structure
    a ->
    -- | The function that is used internally to convert to the @[a]@ so that the function can process further the permutations
    (t a -> [a]) ->
    -- | The function that is used internally to convert to the @[[a]]@ so that the function can process further
    ((t (t a)) -> [[a]]) ->
    -- | The function that is used internally to convert to the needed representation that the function can process further
    ([a] -> t a) ->
    -- | The permutations of 'Int' indices starting from 0 and up to n (n is probably less than 8).
    [Array Int Int] ->
    -- | Must be obtained as @subG whspss xs@ or in equivalent way
    t (t a) ->
    [t a]
uniquenessVariants2GNPBL :: forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL !t a
ts !t a
us !a
hd t a -> [a]
f1 t (t a) -> [[a]]
f2 [a] -> t a
f3 [Array Int Int]
perms !t (t a)
subs
    | t (t a) -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t (t a)
subs = [t a]
forall a. Monoid a => a
mempty
    | Bool
otherwise = ([a] -> t a) -> [[a]] -> [t a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> t a
f3 [[a]]
ns
  where
    !uss :: t (t a)
uss = (a
hd a -> t a -> t a
forall (t :: * -> *) a. InsertLeft t a => a -> t a -> t a
%@ t a
us) t a -> t (t a) -> t (t a)
forall (t :: * -> *) a. InsertLeft t a => t a -> t (t a) -> t (t a)
%^ t (t a)
forall a. Monoid a => a
mempty
    !base0 :: [[a]]
base0 = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
hd a -> [a] -> [a]
forall (t :: * -> *) a. InsertLeft t a => a -> t a -> t a
%@) ([[a]] -> [[a]]) -> (t (t a) -> [[a]]) -> t (t a) -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (t a) -> [[a]]
f2 (t (t a) -> [[a]]) -> t (t a) -> [[a]]
forall a b. (a -> b) -> a -> b
$ t (t a)
subs
    !l :: Int
l = [[a]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length [[a]]
base0
    !baseArr :: Array Int [a]
baseArr = (Int, Int) -> [[a]] -> Array Int [a]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [[a]]
base0
    !ns :: [[a]]
ns = t a
-> t (t a)
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> [Array Int Int]
-> Array Int [a]
-> [[a]]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t (t a)
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> [Array Int Int]
-> Array Int [a]
-> [[a]]
universalSetGL t a
ts t (t a)
uss t a -> [a]
f1 t (t a) -> [[a]]
f2 [Array Int Int]
perms Array Int [a]
baseArr -- in map f3 ns
{-# INLINE uniquenessVariants2GNPBL #-}
{-# SPECIALIZE uniquenessVariants2GNPBL ::
    String ->
    String ->
    Char ->
    (String -> String) ->
    ([String] -> [String]) ->
    (String -> String) ->
    [Array Int Int] ->
    [String] ->
    [String]
    #-}