-- |
-- Module      :  Phladiprelio.General.SpecificationsRead
-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
--  Provides functions to read data specifications for other modules from textual files.


{-# LANGUAGE NoImplicitPrelude #-}


module Phladiprelio.General.SpecificationsRead where

import GHC.Base
import GHC.List
import Data.List (sort,lines)
import Data.Char (isAlpha)
import Phladiprelio.RGLPK.General
import System.Environment (getArgs)
import GHC.Arr
import Text.Read
import Data.Maybe (fromMaybe,fromJust)
import GHC.Int
import Phladiprelio.General.Base

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

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 -> [[Char]] -> [[[Char]]]
groupBetweenChars Char
c [] = []
groupBetweenChars Char
c [[Char]]
xs = [[Char]]
css [[Char]] -> [[[Char]]] -> [[[Char]]]
forall a. a -> [a] -> [a]
: Char -> [[Char]] -> [[[Char]]]
groupBetweenChars Char
c (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> [Char] -> Bool
charLine Char
c) [[Char]]
dss)
  where ([[Char]]
css,[[Char]]
dss) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> [Char] -> Bool
charLine Char
c) [[Char]]
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 -> [Char] -> GWritingSystemPRPLX
getGWritingSystem Char
c [Char]
xs = ([[Char]] -> ([PhoneticsRepresentationPLX], Int8))
-> [[[Char]]] -> GWritingSystemPRPLX
forall a b. (a -> b) -> [a] -> [b]
map ((\([[Char]]
t1,[[Char]]
t2) -> ([PhoneticsRepresentationPLX] -> [PhoneticsRepresentationPLX]
forall a. Ord a => [a] -> [a]
sort ([PhoneticsRepresentationPLX] -> [PhoneticsRepresentationPLX])
-> ([[Char]] -> [PhoneticsRepresentationPLX])
-> [[Char]]
-> [PhoneticsRepresentationPLX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> PhoneticsRepresentationPLX)
-> [[Char]] -> [PhoneticsRepresentationPLX]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
kt -> Maybe PhoneticsRepresentationPLX -> PhoneticsRepresentationPLX
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe PhoneticsRepresentationPLX
forall a. PhoneticElement a => [Char] -> Maybe a
readPEMaybe [Char]
kt::Maybe PhoneticsRepresentationPLX)) ([[Char]] -> [PhoneticsRepresentationPLX])
-> [[Char]] -> [PhoneticsRepresentationPLX]
forall a b. (a -> b) -> a -> b
$ [[Char]]
t2,
         [Char] -> Int8
forall a. Read a => [Char] -> a
read ([[Char]] -> [Char]
forall a. [[a]] -> [a]
concat [[Char]]
t1)::Int8)) (([[Char]], [[Char]]) -> ([PhoneticsRepresentationPLX], Int8))
-> ([[Char]] -> ([[Char]], [[Char]]))
-> [[Char]]
-> ([PhoneticsRepresentationPLX], Int8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> ([[Char]], [[Char]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1) ([[[Char]]] -> GWritingSystemPRPLX)
-> ([Char] -> [[[Char]]]) -> [Char] -> GWritingSystemPRPLX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [[Char]] -> [[[Char]]]
groupBetweenChars Char
c ([[Char]] -> [[[Char]]])
-> ([Char] -> [[Char]]) -> [Char] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> GWritingSystemPRPLX) -> [Char] -> GWritingSystemPRPLX
forall a b. (a -> b) -> a -> b
$ [Char]
xs