{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Data.Phonetic.Languages.Undefined
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- This is a computational scheme for generalized usage of the phonetic languages approach. 
-- The functions themselves are 'undefined' but with some type. They are just templates and some general idea.
-- Please, provide your own implementation instead of using these ones.

module Data.Phonetic.Languages.Undefined {-# WARNING "This module contains just some templates and ideas. Please, provide the analogous functions by yourself, these ones while used return 'undefined'. " #-} (
  -- * Convert to the 'PhoneticsRepresentationPL'.
  stringToPRPL
  -- * Apply conversion from 'PhoneticsRepresentationPL'.
  , fromPRPL2X
  , rules
  , rulesPR
  -- * Convert from the 'PhoneticsRepresentationPL' after applying 'rulesPR' function
  -- or from the 'PhoneticsRepresentationPLX' after applying 'rulesX' function.
  , showRepr
  -- * Divide into syllables after both conversions.
  , toSyllables
) where

import Data.Phonetic.Languages.Base

{-| Every 'Char' value represents here the phonetic phenomenon, mostly (usually, or often) some phoneme.
-}
rulesPR :: PhoneticsRepresentationPL -> Char
rulesPR :: PhoneticsRepresentationPL -> Char
rulesPR (PREmpty String
xs) = String -> Maybe String -> Maybe String -> Char
rules String
xs Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
rulesPR (PRAfter String
xs String
ys) = String -> Maybe String -> Maybe String -> Char
rules String
xs (String -> Maybe String
forall a. a -> Maybe a
Just String
ys) Maybe String
forall a. Maybe a
Nothing
rulesPR (PRBefore String
xs String
zs) = String -> Maybe String -> Maybe String -> Char
rules String
xs Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
zs)
rulesPR (PR String
xs String
ys String
zs) = String -> Maybe String -> Maybe String -> Char
rules String
xs (String -> Maybe String
forall a. a -> Maybe a
Just String
ys) (String -> Maybe String
forall a. a -> Maybe a
Just String
zs)
{-# INLINE rulesPR #-}

fromPRPL2X :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX
fromPRPL2X :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX
fromPRPL2X y :: PhoneticsRepresentationPL
y@(PREmpty String
xs) = String -> Char -> PhoneticsRepresentationPLX
PREmptyC String
xs (PhoneticsRepresentationPL -> Char
rulesPR PhoneticsRepresentationPL
y)
fromPRPL2X y :: PhoneticsRepresentationPL
y@(PRAfter String
xs String
ys) = String -> String -> Char -> PhoneticsRepresentationPLX
PRAfterC String
xs String
ys (PhoneticsRepresentationPL -> Char
rulesPR PhoneticsRepresentationPL
y)
fromPRPL2X y :: PhoneticsRepresentationPL
y@(PRBefore String
xs String
zs) = String -> String -> Char -> PhoneticsRepresentationPLX
PRBeforeC String
xs String
zs (PhoneticsRepresentationPL -> Char
rulesPR PhoneticsRepresentationPL
y)
fromPRPL2X y :: PhoneticsRepresentationPL
y@(PR String
xs String
ys String
zs) = String -> String -> String -> Char -> PhoneticsRepresentationPLX
PRC String
xs String
ys String
zs (PhoneticsRepresentationPL -> Char
rulesPR PhoneticsRepresentationPL
y)
{-# INLINE fromPRPL2X #-}

{-| The text is converted to the phonetic languages representation by this function.
It is intended to be exported qualified, so that the function in every language
implementation has the same name and signature as here and the data type is used there.
Please, use this function only as a type and semantics template and implement your own one where needed.
If you can define some function 'stringToPRPL' where every 'PhoneticRepresentationPL' corresponds to the distinguishable
phonetic phenomenae then it is a considerable application for the possible phonetic languages approach usability for the
data.
-}
stringToPRPL :: String -> [PhoneticsRepresentationPL]
stringToPRPL :: String -> [PhoneticsRepresentationPL]
stringToPRPL = String -> [PhoneticsRepresentationPL]
forall a. HasCallStack => a
undefined

{-| Every 'Char' value represents here the phonetic phenomenon, mostly (usually, or often) some phoneme.
It is intended to be exported qualified, so that the function in every language
implementation has the same name and signature as here and the data type is used there.
Please, use this function only as a type and semantics template and implement your own one where needed.
-}
rules
  :: String -- ^ Is gotten as 'string' from 'PhoneticsRepresentationPL'
  -> Maybe String -- ^ Is gotten as 'afterString' from 'PhoneticsRepresentationPL'. Is 'Nothing' if there is no any.
  -> Maybe String -- ^ Is gotten as 'beforeString' from 'PhoneticsRepresentationPL'. Is 'Nothing' if there is no any.
  -> Char 
rules :: String -> Maybe String -> Maybe String -> Char
rules = String -> Maybe String -> Maybe String -> Char
forall a. HasCallStack => a
undefined

{-| Converts the converted from the 'PhoneticsRepresentationPL' conversion 'String' to syllables. 
It is intended to be exported qualified, so that the function in every language
implementation has the same name and signature as here and the data type is used there.
Please, use this function only as a type and semantics template and implement your own one where needed.
-}
toSyllables :: String -> [String]
toSyllables :: String -> [String]
toSyllables = String -> [String]
forall a. HasCallStack => a
undefined

{-| Converts the converted from the 'PhoneticsRepresentationPL' conversion 'Char' to the usual written
in the language 'String' for the phenomenon. 
It is intended to be exported qualified, so that the function in every language
implementation has the same name and signature as here and the data type is used there.
Please, use this function only as a type and semantics template and implement your own one where needed.
After you have defined the 'rules' and 'showRepr' functions, you can implement the instance for 'Show' class
for the 'PhoneticsRepresentationPL' as:
instance Show PhoneticsRepresentationPL where
  show = showRepr . rulesPR
  {-# INLINE show #-}

Similarly for the 'PhoneticsRepresentationPLX':
instance Show PhoneticsRepresentationPLX where
  show = showRepr . rulesX
  {-# INLINE show #-}
-}
showRepr :: Char -> String
showRepr :: Char -> String
showRepr = Char -> String
forall a. HasCallStack => a
undefined