-- | Module for functionality common between the various Function types (AtomFunction, DatabaseContextFunction).
module ProjectM36.Function where
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.Serialise.Base ()
import ProjectM36.ScriptSession
import qualified Data.HashSet as HS

-- for merkle hash                       

-- | Return the underlying function to run the Function.
function :: FunctionBody a -> a
function :: FunctionBody a -> a
function (FunctionScriptBody FunctionBodyScript
_ a
f) = a
f
function (FunctionBuiltInBody a
f) = a
f
function (FunctionObjectLoadedBody FilePath
_ FilePath
_ FilePath
_ a
f) = a
f

-- | Return the text-based Haskell script, if applicable.
functionScript :: Function a -> Maybe FunctionBodyScript
functionScript :: Function a -> Maybe FunctionBodyScript
functionScript Function a
func = case Function a -> FunctionBody a
forall a. Function a -> FunctionBody a
funcBody Function a
func of
  FunctionScriptBody FunctionBodyScript
script a
_ -> FunctionBodyScript -> Maybe FunctionBodyScript
forall a. a -> Maybe a
Just FunctionBodyScript
script
  FunctionBody a
_ -> Maybe FunctionBodyScript
forall a. Maybe a
Nothing

-- | Change atom function definition to reference proper object file source. Useful when moving the object file into the database directory.
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
   --functions inside object files probably won't have the right function body metadata
   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 :: FunctionBodyScript
-> HashSet (Function a) -> Either RelationalError (Function a)
functionForName FunctionBodyScript
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
$ FunctionBodyScript -> RelationalError
NoSuchFunctionError FunctionBodyScript
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 -> FunctionBodyScript
forall a. Function a -> FunctionBodyScript
funcName Function a
f FunctionBodyScript -> FunctionBodyScript -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionBodyScript
funcName') HashSet (Function a)
funcSet