<commit_before>{-# LANGUAGE FlexibleInstances #-}
{- | This Module gives an abstraction from the PGF format provided by GF -}
module Muste.Grammar where
import PGF
import PGF.Internal
import Data.Maybe

-- | Type 'FunType' consists of a CId that is the the result category and [CId] are the parameter categories
data FunType = Fun CId [CId] | NoType deriving (Ord)

-- | Type 'Rule' consists of a CId as the function name and a 'FunType' as the Type
data Rule = Function CId FunType deriving (Ord,Eq)

-- | Type 'Grammar' consists of a start categorie and a list of rules
data Grammar = Grammar {
  startcat :: CId,
  rules :: [Rule],
  pgf :: PGF
  }

-- | A 'Grammar' is in the Show class
instance Show Grammar where
  show (Grammar startcat rules _) =
    "Startcat: " ++ show startcat ++ "\nRules:\n " ++
    (unwords $ map show rules)

-- | A 'FunType' is in the Show class
instance Show FunType where
  show (Fun cat []) =
    "(" ++ show cat ++ ")"
  show (Fun cat cats) =
    "(" ++ (foldl (\a -> \b -> a ++ " -> " ++ (show b)) (show $ head cats) (tail cats) ++ " -> " ++ show cat) ++ ")"
  show (NoType) = "()"

-- | The function 'readId' is a helper to read a 'FunType'
readId :: String -> Maybe (CId,String)
readId str =
  let
    result = readsPrec 0 str
  in
    if result == [] then Nothing else Just $ head result
  
-- | A 'FunType' is in the Read class
instance Read FunType where
  readsPrec _ sType =
    let
      readType :: String -> ([CId],String)
      readType ('(':rest) = readType rest
      readType (')':rest) = ([],rest)
      readType (' ':'-':'>':' ':rest) =
        let
          result = readType rest
        in
          (fst result, snd result)
      readType "" = ([],"")
      readType rest =
        let
          result = readId rest
        in
          case result of {
            Just r -> let more = readType $ snd r in ((fst r):(fst more), snd more) ;
            _ -> ([],rest)
            }
      result = readType sType
      cats = fst result
    in
      [((Fun (last cats) (init cats)),snd result)]

-- | A 'FunType' is a member of Eq class
{-
  Function types are equal if all hypothesises and the resulting category are equal
-}
instance Eq FunType where
  (==) (Fun id1 pre1) (Fun id2 pre2) = (id1 == id2) && (pre1 == pre2) 

-- | A 'Rule' is member of the Show class
instance Show Rule where
  show (Function name funtype) =
    show name ++ " : " ++ show funtype ;

-- | The function 'getFunType' extracts the function type from a grammar given a function name
getFunType :: PGF -> CId -> FunType
getFunType grammar id =
  let
    typ = fromJust $ functionType grammar id -- Here is some uncertainty from the grammar but we just assume there will always be a type
    (hypos,typeid,exprs) = unType typ
    cats = (map (\(_,_,DTyp _ cat _) -> cat) hypos)
  in
    (Fun typeid cats) ;

-- | The function 'getFunCat' extracts the result category from a function type
getFunCat :: FunType -> CId
getFunCat (Fun cat _) = cat
<commit_msg>removed useless implementation of Eq<commit_after>{-# LANGUAGE FlexibleInstances #-}
{- | This Module gives an abstraction from the PGF format provided by GF -}
module Muste.Grammar where
import PGF
import PGF.Internal
import Data.Maybe

-- | Type 'FunType' consists of a CId that is the the result category and [CId] are the parameter categories
data FunType = Fun CId [CId] | NoType deriving (Ord,Eq)

-- | Type 'Rule' consists of a CId as the function name and a 'FunType' as the Type
data Rule = Function CId FunType deriving (Ord,Eq)

-- | Type 'Grammar' consists of a start categorie and a list of rules
data Grammar = Grammar {
  startcat :: CId,
  rules :: [Rule],
  pgf :: PGF
  }

-- | A 'Grammar' is in the Show class
instance Show Grammar where
  show (Grammar startcat rules _) =
    "Startcat: " ++ show startcat ++ "\nRules:\n " ++
    (unwords $ map show rules)

-- | A 'FunType' is in the Show class
instance Show FunType where
  show (Fun cat []) =
    "(" ++ show cat ++ ")"
  show (Fun cat cats) =
    "(" ++ (foldl (\a -> \b -> a ++ " -> " ++ (show b)) (show $ head cats) (tail cats) ++ " -> " ++ show cat) ++ ")"
  show (NoType) = "()"

-- | The function 'readId' is a helper to read a 'FunType'
readId :: String -> Maybe (CId,String)
readId str =
  let
    result = readsPrec 0 str
  in
    if result == [] then Nothing else Just $ head result
  
-- | A 'FunType' is in the Read class
instance Read FunType where
  readsPrec _ sType =
    let
      readType :: String -> ([CId],String)
      readType ('(':rest) = readType rest
      readType (')':rest) = ([],rest)
      readType (' ':'-':'>':' ':rest) =
        let
          result = readType rest
        in
          (fst result, snd result)
      readType "" = ([],"")
      readType rest =
        let
          result = readId rest
        in
          case result of {
            Just r -> let more = readType $ snd r in ((fst r):(fst more), snd more) ;
            _ -> ([],rest)
            }
      result = readType sType
      cats = fst result
    in
      [((Fun (last cats) (init cats)),snd result)]


-- | A 'Rule' is member of the Show class
instance Show Rule where
  show (Function name funtype) =
    show name ++ " : " ++ show funtype ;

-- | The function 'getFunType' extracts the function type from a grammar given a function name
getFunType :: PGF -> CId -> FunType
getFunType grammar id =
  let
    typ = fromJust $ functionType grammar id -- Here is some uncertainty from the grammar but we just assume there will always be a type
    (hypos,typeid,exprs) = unType typ
    cats = (map (\(_,_,DTyp _ cat _) -> cat) hypos)
  in
    (Fun typeid cats) ;

-- | The function 'getFunCat' extracts the result category from a function type
getFunCat :: FunType -> CId
getFunCat (Fun cat _) = cat

{'fraction_non_alphanumeric': 0.1240913811007269, 'fraction_numerical': 0.0017307026652821046, 'mean_word_length': 2.593905472636816, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 29, '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': '1627067', 'n_tokens_mistral': 1846, 'n_tokens_neox': 1806, 'n_words': 739}