<commit_before>module Proto where

import Types
import HaskellCombinators
import BuildData

import Language.Haskell.Syntax
import Language.Haskell.Pretty

import Control.Monad.Writer
import Data.Char
import qualified Data.Map as M

conPrefix = ("Mk" ++)
modulePrefix =  ("XCB.Gen." ++)

accessor :: String -> String -> String
accessor field typ = field ++ "_" ++ typ

----- Builder monad details
type Builder = Writer BuildData
type Build = Builder ()

-- |Execute the modification of the module under build.
modifyModule :: (HsModule -> HsModule) -> Build
modifyModule = tell . buildHsModule

-- |Call this after building an event type.
-- It logs the event opcode, and eventually adds it to the module-level
-- event variant type.
logEvent :: EventName -> Int -> Build
logEvent name code = tell $ buildEvent name code

-- |Call this after building a request type.
-- It logs the request opcode, and eventually adds it to the module-level
-- request variant type.
logRequest :: RequestName -> Int -> Bool -> Build
logRequest name code hasReply = tell $ buildRequest name code hasReply

-- |Call this after building a request type.
-- It logs the request opcode, and eventually adds it to the module-level
-- error variant type.
logError :: ErrorName -> Int -> Build
logError name code = tell $ buildError name code

runBuilder :: String -> Builder a -> (a, HsModule)
runBuilder name bldr =
    let (x,bdata) = runWriter bldr
        newModule = fModExtras $ mkModule $ modulePrefix name
        BuildResult mod mapEvent mapReq mapErr = applyBuildData bdata newModule

        -- function which adds the module sum-types for events, errors and requests
        fModExtras = mkEventType name mapEvent . mkRequestType name mapReq . mkErrorType name mapErr
    in (x, mod)

-- takes all of the results of running 'logEvent' and turns it into to two things:
--   * a sum-type of all the events in this module
--   * a function mapping that sum-type to it's event opcode
--
-- hopefully we can auto-generate srialization/desrialization here as well
mkEventType :: String -- Module name
            -> M.Map EventName Int
            -> HsModule
            -> HsModule
mkEventType name namesMap = 

    let tyName = name ++ "Event"

        -- Function mapping a module event to its event code
        toCodeFunName = "toEventCode"
        toCodeFnTyp = mkTypeSig toCodeFunName [] (HsTyFun (mkTyCon tyName) (mkTyCon "Int"))
        toCodeFnDec = HsFunBind $ map go $ M.toList namesMap
            where go (typName, code) = 
                      let cons = typName -- the super-type uses the base typenames as constructors
                          result = mkNumLit $ fromIntegral code
                      in mkConsMatch toCodeFunName cons result

        -- Type of any event in this module<commit_msg>force module-names to be upper-case<commit_after>module Proto where

import Types
import HaskellCombinators
import BuildData

import Language.Haskell.Syntax
import Language.Haskell.Pretty

import Control.Monad.Writer
import Data.Char
import qualified Data.Map as M

conPrefix = ("Mk" ++)
modulePrefix =  ("XCB.Gen." ++)

accessor :: String -> String -> String
accessor field typ = field ++ "_" ++ typ

----- Builder monad details
type Builder = Writer BuildData
type Build = Builder ()

-- |Execute the modification of the module under build.
modifyModule :: (HsModule -> HsModule) -> Build
modifyModule = tell . buildHsModule

-- |Call this after building an event type.
-- It logs the event opcode, and eventually adds it to the module-level
-- event variant type.
logEvent :: EventName -> Int -> Build
logEvent name code = tell $ buildEvent name code

-- |Call this after building a request type.
-- It logs the request opcode, and eventually adds it to the module-level
-- request variant type.
logRequest :: RequestName -> Int -> Bool -> Build
logRequest name code hasReply = tell $ buildRequest name code hasReply

-- |Call this after building a request type.
-- It logs the request opcode, and eventually adds it to the module-level
-- error variant type.
logError :: ErrorName -> Int -> Build
logError name code = tell $ buildError name code

runBuilder :: String -> Builder a -> (a, HsModule)
runBuilder nm bldr =
    let (x,bdata) = runWriter bldr
        newModule = fModExtras $ mkModule $ modulePrefix name
        BuildResult mod mapEvent mapReq mapErr = applyBuildData bdata newModule
        name = ensureUpper nm

        -- function which adds the module sum-types for events, errors and requests
        fModExtras = mkEventType name mapEvent . mkRequestType name mapReq . mkErrorType name mapErr
    in (x, mod)

-- takes all of the results of running 'logEvent' and turns it into to two things:
--   * a sum-type of all the events in this module
--   * a function mapping that sum-type to it's event opcode
--
-- hopefully we can auto-generate srialization/desrialization here as well
mkEventType :: String -- Module name
            -> M.Map EventName Int
            -> HsModule
            -> HsModule
mkEventType name namesMap = 

    let tyName = name ++ "Event"

        -- Function mapping a module event to its event code
        toCodeFunName = "toEventCode"
        toCodeFnTyp = mkTypeSig toCodeFunName [] (HsTyFun (mkTyCon tyName) (mkTyCon "Int"))
        toCodeFnDec = HsFunBind $ map go $ M.toList namesMap
            where go (typName, code) = 
                      let cons = typName -- the super-type uses the base typenames as constructors
                          result = mkNumLit $ fromIntegral code
                      in mkConsMatch toCodeFunName cons result

        -- Type of any event in this module
{'fraction_non_alphanumeric': 0.07799787760877255, 'fraction_numerical': 0.0, 'mean_word_length': 2.833898305084746, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 35, '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': '2570205', 'n_tokens_mistral': 1544, 'n_tokens_neox': 1503, 'n_words': 656}