<commit_before>-----------------------------------------------------------------------------
--
-- Module      :  Spec.Parsing
-- Copyright   :  (c) 2011 <NAME>
-- License     :  BSD-style (see the file /LICENSE)
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- | The parser build over the the parsers in openGL-api , and a simple
-- parser to parse the reuse entries.
--
-----------------------------------------------------------------------------

module Spec.Parsing (
    parseSpecs,
    parseReuses,
    parseDeprecations,
) where

-----------------------------------------------------------------------------


--import Control.Monad.State
--import Control.Monad.Writer

import qualified Data.Foldable as F
import Data.List(stripPrefix)
--import qualified Data.Map as M
import Data.Maybe(fromMaybe)
import Data.Monoid

--import Control.Applicative

import qualified Text.OpenGL as P

--import Text.Parsec.String(GenParser)
import Text.Parsec hiding
  (many, optional, (<|>), token)

import Main.Options
import Main.Monad
import Spec.RawSpec

import Language.OpenGLRaw.Base

-----------------------------------------------------------------------------

-- | Parse the needed OpenGL spec files and generate a 'RawSpec' based on
-- them.
parseSpecs :: RawGenIO (LocationMap, ValueMap)
parseSpecs = do
    specLocation <- asksOptions specFile
    registry <- liftEither =<< (liftIO $ P.readRegistry specLocation True)
    let lm = createLocMap registry
        vm = createValMap registry
    return (lm, vm)

createLocMap :: P.Registry -> LocationMap
createLocMap reg =
    F.foldMap extensionLocs (P.regExtensions reg)
    `mappend`
    addLocation (CompVersion 1 0 False) (mkEnumName $ P.EnumName "GL_ZERO") mempty

createValMap :: P.Registry -> ValueMap
createValMap reg =
    F.foldMap enumsMap (P.regEnums reg)
    `mappend`
    F.foldMap commandsMap (P.regCommands reg)
  where
    commandsMap = F.foldMap funcVal . P.commands

enumsMap :: P.Enums -> ValueMap
enumsMap ens = F.foldMap mkEnum $ P.enums ens
  where
    ty = case P.enumsType ens of
        Just "bitfield" -> BitfieldValue
        _               -> EnumValue
    mkEnum (Right _) = mempty
    mkEnum (Left  e) = enumVal ty e

enumVal :: ValueType -> P.GLEnum -> ValueMap
enumVal ty e
    = addValue 
        (mkEnumName $ P.enumName e) 
        (Value (P.enumValue e) ty)
        mempty

funcVal :: P.Command -> ValueMap
funcVal com 
    = addValue 
        (mkFuncName $ P.commandName com)
        (RawFunc retType argTypes alias)
        mempty
  where
    retType = convertType . P.returnType $ P.commandReturnType com
    argTypes = map (convertType . P.paramType) $ P.commandParams com
    alias = mkFuncName `fmap` P.commandAlias com

mkEnumName :: P.EnumName -> EnumName
mkEnumName = wrapName . tryStrip "GL_" . (\(P.EnumName n') -> n')

mkFuncName :: P.CommandName -> FuncName
mkFuncName = wrapName . tryStrip "gl" . (\(P.CommandName n) -> n)

tryStrip :: String -> String -> String
tryStrip pre n = fromMaybe n $ pre `stripPrefix` n

convertType :: P.CType -> FType
convertType ct = case ct of
    P.Struct n      -> convertStruct n
    P.CConst t      -> convertType t
    P.Ptr    t      -> case convertType t of
        UnitTCon    -> TPtr TVar
        t'          -> TPtr t'
    P.BaseType bt   -> convertBaseType bt
    P.AliasType n   -> convertAliasType n

convertStruct :: String -> FType
convertStruct n = case n of
    "_cl_context"   -> TCon "CLcontext"
    "_cl_event"     -> TCon "CLevent"
    _ -> error $ "struct " ++ n
convertBaseType :: P.BaseType -> FType
convertBaseType bt = case bt of
    P.Void -> UnitTCon
    _ -> error $ show bt
convertAliasType :: String -> FType
convertAliasType n = case n of
    "GLboolean"         -> TCon "GLboolean"
    "GLbyte"            -> TCon "GLbyte"
    "GLubyte"           -> TCon "GLubyte"
    "GLchar"            -> TCon "GLchar"
    "GLcharARB"         -> TCon "GLchar"
    "GLshort"           -> TCon "GLshort"
    "GLushort"          -> TCon "GLushort"
    "GLint"             -> TCon "GLint"
    "GLuint"            -> TCon "GLuint"
    "GLfixed"           -> TCon "GLfixed"
    "GLint64"           -> TCon "GLint64"
    "GLint64EXT"        -> TCon "GLint64"
    "GLuint64"          -> TCon "GLuint64"
    "GLuint64EXT"       -> TCon "GLuint64"
    "GLsizei"           -> TCon "GLsizei"
    "GLenum"            -> TCon "GLenum"
    "GLintptr"          -> TCon "GLintptr"
    "GLintptrARB"       -> TCon "GLintptr"
    "GLsizeiptr"        -> TCon "GLsizeiptr"
    "GLsizeiptrARB"     -> TCon "GLsizeiptr"
    "GLbitfield"        -> TCon "GLbitfield"
    "GLsync"            -> TCon "GLsync"
    "GLhalf"            -> TCon "GLhalf"
    "GLhalfNV"          -> TCon "GLhalf"
    "GLfloat"           -> TCon "GLfloat"
    "GLclampf"          -> TCon "GLclampf"
    "GLdouble"          -> TCon "GLdouble"
    "GLclampd"          -> TCon "GLclampd"
    "GLvoid"            -> UnitTCon
    "GLDEBUGPROC"       -> TCon "GLdebugproc"
    "GLDEBUGPROCAMD"    -> TCon "GLdebugproc"
    "GLDEBUGPROCARB"    -> TCon "GLdebugproc"
    "GLDEBUGPROCKHR"    -> TCon "GLdebugproc"
    "GLhandleARB"       -> TCon "GLhandle"
    "GLvdpauSurfaceNV"  -> TCon "GLvdpauSurface"
    _ -> error $ "alias type " ++ n

extensionLocs :: P.Extension -> LocationMap
extensionLocs ext = case P.decomposeExtensionToken $ P.extensionName ext of
    Nothing -> mempty
    Just (vn, name) ->
        F.foldMap addExtensionElem $ P.extensionRequires ext
      where
        cat = CompExtension (CE vn) name False --TODO: just to get it working
        addExtensionElem = F.foldMap addInterfaceElem . P.eeElements
        addInterfaceElem ie = case P.ieElementType ie of
            P.IEnum    eName -> addLocation cat (mkEnumName eName) mempty
            P.ICommand cName -> addLocation cat (mkFuncName cName) mempty
            _       -> mempty --TODO
--        addLocation

{-
    especf <- asksOptions enumextFile >>= liftIO . readFile
    fspecf <- asksOptions glFile >>= liftIO . readFile
    tymapf <- asksOptions tmFile >>= liftIO . readFile
    espec <- liftEither $ parseEnumSpec <$> enumLines especf
    tymap <- liftEither $ mkTypeMap <$> tmLines tymapf
    fspec <- liftEither $ extractFunctions <$> funLines fspecf
    return . mappend espec $ parseFSpec fspec tymap

-----------------------------------------------------------------------------
<commit_msg>Some indentation.<commit_after>-----------------------------------------------------------------------------
--
-- Module      :  Spec.Parsing
-- Copyright   :  (c) 2011 <NAME>
-- License     :  BSD-style (see the file /LICENSE)
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- | The parser build over the the parsers in openGL-api , and a simple
-- parser to parse the reuse entries.
--
-----------------------------------------------------------------------------

module Spec.Parsing (
    parseSpecs,
    parseReuses,
    parseDeprecations,
) where

-----------------------------------------------------------------------------


--import Control.Monad.State
--import Control.Monad.Writer

import qualified Data.Foldable as F
import Data.List(stripPrefix)
--import qualified Data.Map as M
import Data.Maybe(fromMaybe)
import Data.Monoid

--import Control.Applicative

import qualified Text.OpenGL as P

--import Text.Parsec.String(GenParser)
import Text.Parsec hiding
  (many, optional, (<|>), token)

import Main.Options
import Main.Monad
import Spec.RawSpec

import Language.OpenGLRaw.Base

-----------------------------------------------------------------------------

-- | Parse the needed OpenGL spec files and generate a 'RawSpec' based on
-- them.
parseSpecs :: RawGenIO (LocationMap, ValueMap)
parseSpecs = do
    specLocation <- asksOptions specFile
    registry <- liftEither =<< (liftIO $ P.readRegistry specLocation True)
    let lm = createLocMap registry
        vm = createValMap registry
    return (lm, vm)

createLocMap :: P.Registry -> LocationMap
createLocMap reg =
    F.foldMap extensionLocs (P.regExtensions reg)
    `mappend`
    addLocation (CompVersion 1 0 False) (mkEnumName $ P.EnumName "GL_ZERO") mempty

createValMap :: P.Registry -> ValueMap
createValMap reg =
    F.foldMap enumsMap (P.regEnums reg)
    `mappend`
    F.foldMap commandsMap (P.regCommands reg)
  where
    commandsMap = F.foldMap funcVal . P.commands

enumsMap :: P.Enums -> ValueMap
enumsMap ens = F.foldMap mkEnum $ P.enums ens
  where
    ty = case P.enumsType ens of
        Just "bitfield" -> BitfieldValue
        _               -> EnumValue
    mkEnum (Right _) = mempty
    mkEnum (Left  e) = enumVal ty e

enumVal :: ValueType -> P.GLEnum -> ValueMap
enumVal ty e
    = addValue 
        (mkEnumName $ P.enumName e) 
        (Value (P.enumValue e) ty)
        mempty

funcVal :: P.Command -> ValueMap
funcVal com 
    = addValue 
        (mkFuncName $ P.commandName com)
        (RawFunc retType argTypes alias)
        mempty
  where
    retType = convertType . P.returnType $ P.commandReturnType com
    argTypes = map (convertType . P.paramType) $ P.commandParams com
    alias = mkFuncName `fmap` P.commandAlias com

mkEnumName :: P.EnumName -> EnumName
mkEnumName = wrapName . tryStrip "GL_" . (\(P.EnumName n') -> n')

mkFuncName :: P.CommandName -> FuncName
mkFuncName = wrapName . tryStrip "gl" . (\(P.CommandName n) -> n)

tryStrip :: String -> String -> String
tryStrip pre n = fromMaybe n $ pre `stripPrefix` n

convertType :: P.CType -> FType
convertType ct = case ct of
    P.Struct n      -> convertStruct n
    P.CConst t      -> convertType t
    P.Ptr    t      -> case convertType t of
        UnitTCon    -> TPtr TVar
        t'          -> TPtr t'
    P.BaseType bt   -> convertBaseType bt
    P.AliasType n   -> convertAliasType n

convertStruct :: String -> FType
convertStruct n = case n of
    "_cl_context"   -> TCon "CLcontext"
    "_cl_event"     -> TCon "CLevent"
    _               -> error $ "struct " ++ n
convertBaseType :: P.BaseType -> FType
convertBaseType bt = case bt of
    P.Void  -> UnitTCon
    _       -> error $ show bt
convertAliasType :: String -> FType
convertAliasType n = case n of
    "GLboolean"         -> TCon "GLboolean"
    "GLbyte"            -> TCon "GLbyte"
    "GLubyte"           -> TCon "GLubyte"
    "GLchar"            -> TCon "GLchar"
    "GLcharARB"         -> TCon "GLchar"
    "GLshort"           -> TCon "GLshort"
    "GLushort"          -> TCon "GLushort"
    "GLint"             -> TCon "GLint"
    "GLuint"            -> TCon "GLuint"
    "GLfixed"           -> TCon "GLfixed"
    "GLint64"           -> TCon "GLint64"
    "GLint64EXT"        -> TCon "GLint64"
    "GLuint64"          -> TCon "GLuint64"
    "GLuint64EXT"       -> TCon "GLuint64"
    "GLsizei"           -> TCon "GLsizei"
    "GLenum"            -> TCon "GLenum"
    "GLintptr"          -> TCon "GLintptr"
    "GLintptrARB"       -> TCon "GLintptr"
    "GLsizeiptr"        -> TCon "GLsizeiptr"
    "GLsizeiptrARB"     -> TCon "GLsizeiptr"
    "GLbitfield"        -> TCon "GLbitfield"
    "GLsync"            -> TCon "GLsync"
    "GLhalf"            -> TCon "GLhalf"
    "GLhalfNV"          -> TCon "GLhalf"
    "GLfloat"           -> TCon "GLfloat"
    "GLclampf"          -> TCon "GLclampf"
    "GLdouble"          -> TCon "GLdouble"
    "GLclampd"          -> TCon "GLclampd"
    "GLvoid"            -> UnitTCon
    "GLDEBUGPROC"       -> TCon "GLdebugproc"
    "GLDEBUGPROCAMD"    -> TCon "GLdebugproc"
    "GLDEBUGPROCARB"    -> TCon "GLdebugproc"
    "GLDEBUGPROCKHR"    -> TCon "GLdebugproc"
    "GLhandleARB"       -> TCon "GLhandle"
    "GLvdpauSurfaceNV"  -> TCon "GLvdpauSurface"
    _                   -> error $ "alias type " ++ n

extensionLocs :: P.Extension -> LocationMap
extensionLocs ext = case P.decomposeExtensionToken $ P.extensionName ext of
    Nothing -> mempty
    Just (vn, name) ->
        F.foldMap addExtensionElem $ P.extensionRequires ext
      where
        cat = CompExtension (CE vn) name False --TODO: just to get it working
        addExtensionElem = F.foldMap addInterfaceElem . P.eeElements
        addInterfaceElem ie = case P.ieElementType ie of
            P.IEnum    eName -> addLocation cat (mkEnumName eName) mempty
            P.ICommand cName -> addLocation cat (mkFuncName cName) mempty
            _       -> mempty --TODO
--        addLocation

{-
    especf <- asksOptions enumextFile >>= liftIO . readFile
    fspecf <- asksOptions glFile >>= liftIO . readFile
    tymapf <- asksOptions tmFile >>= liftIO . readFile
    espec <- liftEither $ parseEnumSpec <$> enumLines especf
    tymap <- liftEither $ mkTypeMap <$> tmLines tymapf
    fspec <- liftEither $ extractFunctions <$> funLines fspecf
    return . mappend espec $ parseFSpec fspec tymap

-----------------------------------------------------------------------------

{'fraction_non_alphanumeric': 0.16182313985196728, 'fraction_numerical': 0.003428126217374367, 'mean_word_length': 1.8626226583407672, 'pattern_counts': {'":': 0, '<': 33, '<?xml version=': 0, '>': 169, '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': '615593', 'n_tokens_mistral': 4026, 'n_tokens_neox': 3988, 'n_words': 1087}