module ProjectM36.Function where
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.Serialise.Base ()
import ProjectM36.ScriptSession
import qualified Data.ByteString.Lazy as BL
import Codec.Winery
import qualified Data.HashSet as HS
hashBytes :: Function a -> BL.ByteString
hashBytes :: Function a -> ByteString
hashBytes Function a
func = [ByteString] -> ByteString
BL.fromChunks [ByteString
fname, ByteString
ftype, ByteString
fbody]
where
fname :: ByteString
fname = FunctionName -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Function a -> FunctionName
forall a. Function a -> FunctionName
funcName Function a
func)
ftype :: ByteString
ftype = [AtomType] -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Function a -> [AtomType]
forall a. Function a -> [AtomType]
funcType Function a
func)
fbody :: ByteString
fbody = case Function a -> FunctionBody a
forall a. Function a -> FunctionBody a
funcBody Function a
func of
FunctionScriptBody FunctionName
s a
_ -> FunctionName -> ByteString
forall a. Serialise a => a -> ByteString
serialise FunctionName
s
FunctionBuiltInBody a
_ -> () -> ByteString
forall a. Serialise a => a -> ByteString
serialise ()
FunctionObjectLoadedBody FilePath
a FilePath
b FilePath
c a
_ -> (FilePath, FilePath, FilePath) -> ByteString
forall a. Serialise a => a -> ByteString
serialise (FilePath
a,FilePath
b,FilePath
c)
function :: FunctionBody a -> a
function :: FunctionBody a -> a
function (FunctionScriptBody FunctionName
_ a
f) = a
f
function (FunctionBuiltInBody a
f) = a
f
function (FunctionObjectLoadedBody FilePath
_ FilePath
_ FilePath
_ a
f) = a
f
functionScript :: Function a -> Maybe FunctionBodyScript
functionScript :: Function a -> Maybe FunctionName
functionScript Function a
func = case Function a -> FunctionBody a
forall a. Function a -> FunctionBody a
funcBody Function a
func of
FunctionScriptBody FunctionName
script a
_ -> FunctionName -> Maybe FunctionName
forall a. a -> Maybe a
Just FunctionName
script
FunctionBody a
_ -> Maybe FunctionName
forall a. Maybe a
Nothing
processObjectLoadedFunctionBody :: ObjectModuleName -> ObjectFileEntryFunctionName -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody :: FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody FilePath
modName FilePath
fentry FilePath
objPath FunctionBody a
body =
FilePath -> FilePath -> FilePath -> a -> FunctionBody a
forall a. FilePath -> FilePath -> FilePath -> a -> FunctionBody a
FunctionObjectLoadedBody FilePath
objPath FilePath
modName FilePath
fentry a
f
where
f :: a
f = FunctionBody a -> a
forall a. FunctionBody a -> a
function FunctionBody a
body
processObjectLoadedFunctions :: Functor f => ObjectModuleName -> ObjectFileEntryFunctionName -> FilePath -> f (Function a) -> f (Function a)
processObjectLoadedFunctions :: FilePath
-> FilePath -> FilePath -> f (Function a) -> f (Function a)
processObjectLoadedFunctions FilePath
modName FilePath
entryName FilePath
path =
(Function a -> Function a) -> f (Function a) -> f (Function a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Function a
f -> Function a
f { funcBody :: FunctionBody a
funcBody = FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
forall a.
FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody FilePath
modName FilePath
entryName FilePath
path (Function a -> FunctionBody a
forall a. Function a -> FunctionBody a
funcBody Function a
f) } )
loadFunctions :: ModName -> FuncName -> Maybe FilePath -> FilePath -> IO (Either LoadSymbolError [Function a])
#ifdef PM36_HASKELL_SCRIPTING
loadFunctions :: FilePath
-> FilePath
-> Maybe FilePath
-> FilePath
-> IO (Either LoadSymbolError [Function a])
loadFunctions FilePath
modName FilePath
funcName' Maybe FilePath
mModDir FilePath
objPath =
case Maybe FilePath
mModDir of
Just FilePath
modDir -> do
Either LoadSymbolError [Function a]
eNewFs <- ObjectLoadMode
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either LoadSymbolError [Function a])
forall a.
ObjectLoadMode
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> IO (Either LoadSymbolError a)
loadFunctionFromDirectory ObjectLoadMode
LoadAutoObjectFile FilePath
modName FilePath
funcName' FilePath
modDir FilePath
objPath
case Either LoadSymbolError [Function a]
eNewFs of
Left LoadSymbolError
err -> Either LoadSymbolError [Function a]
-> IO (Either LoadSymbolError [Function a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadSymbolError -> Either LoadSymbolError [Function a]
forall a b. a -> Either a b
Left LoadSymbolError
err)
Right [Function a]
newFs ->
Either LoadSymbolError [Function a]
-> IO (Either LoadSymbolError [Function a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Function a] -> Either LoadSymbolError [Function a]
forall a b. b -> Either a b
Right ([Function a] -> [Function a]
forall a. [Function a] -> [Function a]
processFuncs [Function a]
newFs))
Maybe FilePath
Nothing -> do
ObjectLoadMode
-> FilePath
-> FilePath
-> FilePath
-> IO (Either LoadSymbolError [Function a])
forall a.
ObjectLoadMode
-> FilePath
-> FilePath
-> FilePath
-> IO (Either LoadSymbolError a)
loadFunction ObjectLoadMode
LoadAutoObjectFile FilePath
modName FilePath
funcName' FilePath
objPath
where
processFuncs :: [Function a] -> [Function a]
processFuncs = (Function a -> Function a) -> [Function a] -> [Function a]
forall a b. (a -> b) -> [a] -> [b]
map Function a -> Function a
forall a. Function a -> Function a
processor
processor :: Function a -> Function a
processor Function a
newF = Function a
newF { funcBody :: FunctionBody a
funcBody = FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
forall a.
FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody FilePath
modName FilePath
funcName' FilePath
objPath (Function a -> FunctionBody a
forall a. Function a -> FunctionBody a
funcBody Function a
newF)}
#else
loadFunctions _ _ _ _ = pure (Left LoadSymbolError)
#endif
functionForName :: FunctionName -> HS.HashSet (Function a) -> Either RelationalError (Function a)
functionForName :: FunctionName
-> HashSet (Function a) -> Either RelationalError (Function a)
functionForName FunctionName
funcName' HashSet (Function a)
funcSet = if HashSet (Function a) -> Bool
forall a. HashSet a -> Bool
HS.null HashSet (Function a)
foundFunc then
RelationalError -> Either RelationalError (Function a)
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError (Function a))
-> RelationalError -> Either RelationalError (Function a)
forall a b. (a -> b) -> a -> b
$ FunctionName -> RelationalError
NoSuchFunctionError FunctionName
funcName'
else
Function a -> Either RelationalError (Function a)
forall a b. b -> Either a b
Right (Function a -> Either RelationalError (Function a))
-> Function a -> Either RelationalError (Function a)
forall a b. (a -> b) -> a -> b
$ [Function a] -> Function a
forall a. [a] -> a
head ([Function a] -> Function a) -> [Function a] -> Function a
forall a b. (a -> b) -> a -> b
$ HashSet (Function a) -> [Function a]
forall a. HashSet a -> [a]
HS.toList HashSet (Function a)
foundFunc
where
foundFunc :: HashSet (Function a)
foundFunc = (Function a -> Bool)
-> HashSet (Function a) -> HashSet (Function a)
forall a. (a -> Bool) -> HashSet a -> HashSet a
HS.filter (\Function a
f -> Function a -> FunctionName
forall a. Function a -> FunctionName
funcName Function a
f FunctionName -> FunctionName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionName
funcName') HashSet (Function a)
funcSet