{-# LANGUAGE NoImplicitPrelude #-}

{- |
Module      :  Aftovolio.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.
-}
module Aftovolio.General.SpecificationsRead where

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

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 ::
    -- | A delimiter (can be used probably multiple times) used between different parts of the data.
    Char ->
    -- | A list of 'String' that is partitioned using the 'String' starting with the delimiter.
    [String] ->
    [[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 ::
    -- | A delimiter (cab be used probably multiple times) between different parts of the data file. Usually, a tilda sign \'~\'.
    Char ->
    -- | Actually the 'String' that is read into the result.
    String ->
    -- | The data is used to obtain the phonetic language representation of the text.
    GWritingSystemPRPLX
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