-- | 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.ByteString.Lazy as BL
import Codec.Winery
import qualified Data.HashSet as HS

-- for merkle hash                       
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)

-- | Return the underlying function to run the Function.
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

-- | Return the text-based Haskell script, if applicable.
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

-- | 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 :: 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