<commit_before>module Schema
( Schema
, LayerCompiled
, parseSchema
, schematize
, schematizeSent
) where 

import System.Environment
import Control.Exception (throwIO)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Text.Parsec
import qualified Text.Parsec.Token as Token
import Text.Parsec.Language (haskellDef)
import Data.Char (isSpace)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (intercalate, transpose)
import Data.Maybe (catMaybes)
import Control.Monad (liftM, liftM2)
import Data.Binary (Binary, get, put, putWord8, getWord8)

import Control.Parallel (pseq)
import Control.Parallel.Strategies (parList, using, rseq)
import CRF.Control.Eval (forceList)

import Text.Data (LincWord, orth, interps, probs)
import Text.Linc.Parser (parseLinc)
import Text.Tagset.Data (Tagset, Label, Attr, allAtts, attrValues)
import Text.Tagset.DefParser (parseTagset)
import Text.Comment (removeComment)

import qualified CRF.Base as C

-- -- Word translated with respect to some Scheme; a tuple (ws, ds, is), where:
-- --  ws -- list of words, where each word consists of observations
-- --        related to a given layer,
-- --  ds -- disambiguated interpretation (di); list of parts of di divided
-- --        between layers,
-- --  is -- list of interpretations, each interpretation has the same format
-- --        as ds.
-- type SchemedWord = ( [[T.Text]]
--                    , [T.Text]
--                    , [[T.Text]] )

type SchemedWord = C.Word T.Text T.Text
type SchemedSent = C.Sent T.Text T.Text

-- Observation types
data Obv = Orth Int
         | Prefix Int Int
         | Suffix Int Int
         deriving (Show)

instance Binary Obv where
    put (Orth i)     = putWord8 0 >> put i
    put (Prefix i j) = putWord8 1 >> put i >> put j
    put (Suffix i j) = putWord8 2 >> put i >> put j
    get = do
        tag <- getWord8
        case tag of
            0 -> liftM Orth get
            1 -> liftM2 Prefix get get
            2 -> liftM2 Suffix get get

obvValue :: Obv -> [LincWord] -> Int -> Maybe T.Text
obvValue (Orth i) sent k =
    if k + i >= 0 && k + i < length sent then
        Just $ T.toLower $ orth $ sent !! (k + i)
    else
        Nothing

obvValue (Prefix h i) sent k = do
    orth <- obvValue (Orth i) sent k
    if T.length orth >= fromIntegral h then
        Just $ T.take (fromIntegral h) orth
    else
        Nothing

obvValue (Suffix h i) sent k = do
    orth <- obvValue (Orth i) sent k
    if T.length orth >= fromIntegral h then
        Just $ T.drop (T.length orth - fromIntegral h) orth
    else
        Nothing

-- Group of observations: alternative of conjunctions of observations
type ObvGroup = [[Obv]]

obvGroupValue :: ObvGroup -> [LincWord] -> Int -> [T.Text]
obvGroupValue group sent k =
    catMaybes [conjToStr $ conjValue obvConj | obvConj <- group]
    where
        conjValue = map (\obv -> obvValue obv sent k)
        conjToStr conj = processValues conj >>= return . T.intercalate ape
        -- assumption: single observation value /= ""
        processValues values = sequence values >>= return . map (escape ape)
        -- escape c = T.replace c (T.cons '\\' c)
        escape c = T.replace c (c `T.append` c)<commit_msg>Corrected indentation error in earlier GHC versions<commit_after>module Schema
( Schema
, LayerCompiled
, parseSchema
, schematize
, schematizeSent
) where 

import System.Environment
import Control.Exception (throwIO)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Text.Parsec
import qualified Text.Parsec.Token as Token
import Text.Parsec.Language (haskellDef)
import Data.Char (isSpace)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (intercalate, transpose)
import Data.Maybe (catMaybes)
import Control.Monad (liftM, liftM2)
import Data.Binary (Binary, get, put, putWord8, getWord8)

import Control.Parallel (pseq)
import Control.Parallel.Strategies (parList, using, rseq)
import CRF.Control.Eval (forceList)

import Text.Data (LincWord, orth, interps, probs)
import Text.Linc.Parser (parseLinc)
import Text.Tagset.Data (Tagset, Label, Attr, allAtts, attrValues)
import Text.Tagset.DefParser (parseTagset)
import Text.Comment (removeComment)

import qualified CRF.Base as C

-- -- Word translated with respect to some Scheme; a tuple (ws, ds, is), where:
-- --  ws -- list of words, where each word consists of observations
-- --        related to a given layer,
-- --  ds -- disambiguated interpretation (di); list of parts of di divided
-- --        between layers,
-- --  is -- list of interpretations, each interpretation has the same format
-- --        as ds.
-- type SchemedWord = ( [[T.Text]]
--                    , [T.Text]
--                    , [[T.Text]] )

type SchemedWord = C.Word T.Text T.Text
type SchemedSent = C.Sent T.Text T.Text

-- Observation types
data Obv = Orth Int
         | Prefix Int Int
         | Suffix Int Int
         deriving (Show)

instance Binary Obv where
    put (Orth i)     = putWord8 0 >> put i
    put (Prefix i j) = putWord8 1 >> put i >> put j
    put (Suffix i j) = putWord8 2 >> put i >> put j
    get = do
        tag <- getWord8
        case tag of
            0 -> liftM Orth get
            1 -> liftM2 Prefix get get
            2 -> liftM2 Suffix get get

obvValue :: Obv -> [LincWord] -> Int -> Maybe T.Text
obvValue (Orth i) sent k =
    if k + i >= 0 && k + i < length sent
        then Just $ T.toLower $ orth $ sent !! (k + i)
        else Nothing

obvValue (Prefix h i) sent k = do
    orth <- obvValue (Orth i) sent k
    if T.length orth >= fromIntegral h
        then Just $ T.take (fromIntegral h) orth
        else Nothing

obvValue (Suffix h i) sent k = do
    orth <- obvValue (Orth i) sent k
    if T.length orth >= fromIntegral h
        then Just $ T.drop (T.length orth - fromIntegral h) orth
        else Nothing

-- Group of observations: alternative of conjunctions of observations
type ObvGroup = [[Obv]]

obvGroupValue :: ObvGroup -> [LincWord] -> Int -> [T.Text]
obvGroupValue group sent k =
    catMaybes [conjToStr $ conjValue obvConj | obvConj <- group]
    where
        conjValue = map (\obv -> obvValue obv sent k)
        conjToStr conj = processValues conj >>= return . T.intercalate ape
        -- assumption: single observation value /= ""
        processValues values = sequence values >>= return . map (escape ape)
        -- escape c = T.replace c (T.cons '\\' c)
        escape c = T.replace c (c `T.append` c)
{'fraction_non_alphanumeric': 0.10220994475138122, 'fraction_numerical': 0.004910988336402701, 'mean_word_length': 2.570958904109589, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1012546', 'n_tokens_mistral': 2053, 'n_tokens_neox': 2022, 'n_words': 771}