-- |
-- Module      :  Phonetic.Languages.Permutations.Represent
-- Copyright   :  (c) OleksandrZhabenko 2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Permutations data type to mark the needed permutations type from the other modules.

module Phonetic.Languages.Permutations.Represent (
  PermutationsType(..)
  , bTransform2Perms
) where

import Data.Monoid

data PermutationsType = P Int deriving (PermutationsType -> PermutationsType -> Bool
(PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> Eq PermutationsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PermutationsType -> PermutationsType -> Bool
$c/= :: PermutationsType -> PermutationsType -> Bool
== :: PermutationsType -> PermutationsType -> Bool
$c== :: PermutationsType -> PermutationsType -> Bool
Eq, Eq PermutationsType
Eq PermutationsType
-> (PermutationsType -> PermutationsType -> Ordering)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> Bool)
-> (PermutationsType -> PermutationsType -> PermutationsType)
-> (PermutationsType -> PermutationsType -> PermutationsType)
-> Ord PermutationsType
PermutationsType -> PermutationsType -> Bool
PermutationsType -> PermutationsType -> Ordering
PermutationsType -> PermutationsType -> PermutationsType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PermutationsType -> PermutationsType -> PermutationsType
$cmin :: PermutationsType -> PermutationsType -> PermutationsType
max :: PermutationsType -> PermutationsType -> PermutationsType
$cmax :: PermutationsType -> PermutationsType -> PermutationsType
>= :: PermutationsType -> PermutationsType -> Bool
$c>= :: PermutationsType -> PermutationsType -> Bool
> :: PermutationsType -> PermutationsType -> Bool
$c> :: PermutationsType -> PermutationsType -> Bool
<= :: PermutationsType -> PermutationsType -> Bool
$c<= :: PermutationsType -> PermutationsType -> Bool
< :: PermutationsType -> PermutationsType -> Bool
$c< :: PermutationsType -> PermutationsType -> Bool
compare :: PermutationsType -> PermutationsType -> Ordering
$ccompare :: PermutationsType -> PermutationsType -> Ordering
$cp1Ord :: Eq PermutationsType
Ord)

instance Show PermutationsType where
  show :: PermutationsType -> String
show (P Int
x) = String
"+p " String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` Int -> String
forall a. Show a => a -> String
show Int
x

bTransform2Perms :: [String] -> PermutationsType
bTransform2Perms :: [String] -> PermutationsType
bTransform2Perms [String]
ys
 | [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"1"] = Int -> PermutationsType
P Int
1
 | [String]
ys [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"2"] = Int -> PermutationsType
P Int
2
 | Bool
otherwise = Int -> PermutationsType
P Int
0