-- |
-- Module      :  Data.Phonetic.Languages.SpecificationsRead
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
--  Provides functions to read data specifications for other modules from textual files.

module Data.Phonetic.Languages.SpecificationsRead where

import Data.Char (isAlpha)
import Numeric.Wrapper.R.GLPK.Phonetic.Languages.Durations
import System.Environment (getArgs)
import GHC.Arr
import Text.Read
import Data.List
import Data.Maybe (fromMaybe,fromJust)
import GHC.Int
import Data.Phonetic.Languages.Base

charLine :: Char -> String -> Bool
charLine :: Char -> String -> Bool
charLine Char
c = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [Char
c]) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1

groupBetweenChars
 :: Char  -- ^ A delimiter (can be used probably multiple times) used between different parts of the data.
 -> [String] -- ^ A list of 'String' that is partitioned using the 'String' starting with the delimiter.
 -> [[String]]
groupBetweenChars :: Char -> [String] -> [[String]]
groupBetweenChars Char
c [] = []
groupBetweenChars Char
c [String]
xs = [String]
css [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: Char -> [String] -> [[String]]
groupBetweenChars Char
c ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
charLine Char
c) [String]
dss)
  where ([String]
css,[String]
dss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
charLine Char
c) [String]
xs

{-| An example of the needed data structure to be read correctly is in the file gwrsysExample.txt in the source tarball. 
-}
getGWritingSystem
  :: Char -- ^ A delimiter (cab be used probably multiple times) between different parts of the data file. Usually, a tilda sign \'~\'.
  -> String -- ^ Actually the 'String' that is read into the result. 
  -> GWritingSystemPRPLX -- ^ The data is used to obtain the phonetic language representation of the text.
getGWritingSystem :: Char -> String -> GWritingSystemPRPLX
getGWritingSystem Char
c String
xs = ([String] -> ([PhoneticsRepresentationPLX], Int8))
-> [[String]] -> GWritingSystemPRPLX
forall a b. (a -> b) -> [a] -> [b]
map ((\([String]
t1,[String]
t2) -> ([PhoneticsRepresentationPLX] -> [PhoneticsRepresentationPLX]
forall a. Ord a => [a] -> [a]
sort ([PhoneticsRepresentationPLX] -> [PhoneticsRepresentationPLX])
-> ([String] -> [PhoneticsRepresentationPLX])
-> [String]
-> [PhoneticsRepresentationPLX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> PhoneticsRepresentationPLX)
-> [String] -> [PhoneticsRepresentationPLX]
forall a b. (a -> b) -> [a] -> [b]
map (\String
kt -> Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe PhoneticsRepresentationPLX
forall a. PhoneticElement a => String -> Maybe a
readPEMaybe String
kt::Maybe PhoneticsRepresentationPLX)) ([String] -> [PhoneticsRepresentationPLX])
-> [String] -> [PhoneticsRepresentationPLX]
forall a b. (a -> b) -> a -> b
$ [String]
t2,
         String -> Int8
forall a. Read a => String -> a
read ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
t1)::Int8)) (([String], [String]) -> ([PhoneticsRepresentationPLX], Int8))
-> ([String] -> ([String], [String]))
-> [String]
-> ([PhoneticsRepresentationPLX], Int8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1) ([[String]] -> GWritingSystemPRPLX)
-> (String -> [[String]]) -> String -> GWritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [String] -> [[String]]
groupBetweenChars Char
c ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> GWritingSystemPRPLX) -> String -> GWritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ String
xs