-- | 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 :: forall a. 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 :: forall a. Function a -> Maybe FunctionBodyScript
functionScript Function a
func = case forall a. Function a -> FunctionBody a
funcBody Function a
func of
  FunctionScriptBody FunctionBodyScript
script a
_ -> forall a. a -> Maybe a
Just FunctionBodyScript
script
  FunctionBody a
_ -> 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 :: forall a.
FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody FilePath
modName FilePath
fentry FilePath
objPath FunctionBody a
body =
  forall a. FilePath -> FilePath -> FilePath -> a -> FunctionBody a
FunctionObjectLoadedBody FilePath
objPath FilePath
modName FilePath
fentry a
f
  where
    f :: a
f = forall a. FunctionBody a -> a
function FunctionBody a
body

processObjectLoadedFunctions :: Functor f => ObjectModuleName -> ObjectFileEntryFunctionName -> FilePath -> f (Function a) -> f (Function a)
processObjectLoadedFunctions :: forall (f :: * -> *) a.
Functor f =>
FilePath
-> FilePath -> FilePath -> f (Function a) -> f (Function a)
processObjectLoadedFunctions FilePath
modName FilePath
entryName FilePath
path =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Function a
f -> Function a
f { funcBody :: FunctionBody a
funcBody = forall a.
FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody FilePath
modName FilePath
entryName FilePath
path (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 :: forall a.
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 <- 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left LoadSymbolError
err)
        Right [Function a]
newFs ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (forall {a}. [Function a] -> [Function a]
processFuncs [Function a]
newFs))
    Maybe FilePath
Nothing -> do
      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 = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Function a -> Function a
processor
   processor :: Function a -> Function a
processor Function a
newF = Function a
newF { funcBody :: FunctionBody a
funcBody = forall a.
FilePath
-> FilePath -> FilePath -> FunctionBody a -> FunctionBody a
processObjectLoadedFunctionBody FilePath
modName FilePath
funcName' FilePath
objPath (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 :: forall a.
FunctionBodyScript
-> HashSet (Function a) -> Either RelationalError (Function a)
functionForName FunctionBodyScript
funcName' HashSet (Function a)
funcSet =
  case forall a. HashSet a -> [a]
HS.toList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> HashSet a -> HashSet a
HS.filter (\Function a
f -> forall a. Function a -> FunctionBodyScript
funcName Function a
f forall a. Eq a => a -> a -> Bool
== FunctionBodyScript
funcName') HashSet (Function a)
funcSet of
    [] -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FunctionBodyScript -> RelationalError
NoSuchFunctionError FunctionBodyScript
funcName'
    Function a
x : [Function a]
_ -> forall a b. b -> Either a b
Right Function a
x