{- | JVM Backend query implementations for the Rock query system.

This module implements the queries for JVM lowering, class file emission,
and serialization. Each query is atomic and operates on a single module.
-}
module Elara.JVM.Query (
    runGetJVMIRModuleQuery,
    runGetJVMClassFilesQuery,
    runGetJVMClassBytesQuery,
) where

import Effectful
import H2JVM
import H2JVM.Name

import Effectful.Error.Extra (fromEither)
import Elara.AST.Name (ModuleName)
import Elara.Data.Pretty (Pretty (..), viaShow)
import Elara.Error (ElaraDiagnostic (..), runErrorAsElaraError)
import Elara.JVM.Error (JVMLoweringError)
import Elara.JVM.Lower (lowerModule)
import Elara.Query (Query (..))
import Elara.Query.Effects (QueryEffects)

import Elara.JVM.Emit qualified as Emit
import Elara.JVM.IR qualified as IR
import Rock qualified

-- | Orphan instance, TODO: sort this out by improving h2jvm
instance Pretty CodeConverterError where
    pretty :: CodeConverterError -> Doc AnsiStyle
pretty = CodeConverterError -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow

instance Exception CodeConverterError

instance ElaraDiagnostic CodeConverterError where
    diagnosticMessage :: CodeConverterError -> Doc AnsiStyle
diagnosticMessage = CodeConverterError -> Doc AnsiStyle
forall a. Pretty a => a -> Doc AnsiStyle
pretty

-- | Lower a Core module to JVM IR
runGetJVMIRModuleQuery ::
    (QueryEffects es, Rock.Rock Query :> es) =>
    ModuleName ->
    Eff es IR.Module
runGetJVMIRModuleQuery :: forall (es :: [Effect]).
(QueryEffects es, Rock Query :> es) =>
ModuleName -> Eff es Module
runGetJVMIRModuleQuery ModuleName
mn = forall e (r :: [Effect]) a.
(Exception e, ElaraDiagnostic e, Error ElaraError :> r) =>
Eff (Error e : r) a -> Eff r a
runErrorAsElaraError @JVMLoweringError (Eff (Error JVMLoweringError : es) Module -> Eff es Module)
-> Eff (Error JVMLoweringError : es) Module -> Eff es Module
forall a b. (a -> b) -> a -> b
$ do
    coreModule <- Query (CoreModule CoreBind)
-> Eff (Error JVMLoweringError : es) (CoreModule CoreBind)
forall (es :: [Effect]) (f :: * -> *) a.
(HasCallStack, QueryEffects es, Rock f :> es) =>
f a -> Eff es a
Rock.fetch (ModuleName -> Query (CoreModule CoreBind)
GetFinalisedCoreModule ModuleName
mn)
    lowerModule coreModule

-- | Emit JVM IR to ClassFiles
runGetJVMClassFilesQuery ::
    (QueryEffects es, Rock.Rock Query :> es) =>
    ModuleName ->
    Eff es [ClassFile]
runGetJVMClassFilesQuery :: forall (es :: [Effect]).
(QueryEffects es, Rock Query :> es) =>
ModuleName -> Eff es [ClassFile]
runGetJVMClassFilesQuery ModuleName
mn = forall e (r :: [Effect]) a.
(Exception e, ElaraDiagnostic e, Error ElaraError :> r) =>
Eff (Error e : r) a -> Eff r a
runErrorAsElaraError @JVMLoweringError (Eff (Error JVMLoweringError : es) [ClassFile]
 -> Eff es [ClassFile])
-> Eff (Error JVMLoweringError : es) [ClassFile]
-> Eff es [ClassFile]
forall a b. (a -> b) -> a -> b
$ do
    irModule <- Query Module -> Eff (Error JVMLoweringError : es) Module
forall (es :: [Effect]) (f :: * -> *) a.
(HasCallStack, QueryEffects es, Rock f :> es) =>
f a -> Eff es a
Rock.fetch (ModuleName -> Query Module
GetJVMIRModule ModuleName
mn)
    Emit.emitIRModule irModule

-- | Serialize ClassFiles to bytes with file paths
runGetJVMClassBytesQuery ::
    (QueryEffects es, Rock.Rock Query :> es) =>
    ModuleName ->
    Eff es [(FilePath, LByteString)]
runGetJVMClassBytesQuery :: forall (es :: [Effect]).
(QueryEffects es, Rock Query :> es) =>
ModuleName -> Eff es [(String, LByteString)]
runGetJVMClassBytesQuery ModuleName
mn = forall e (r :: [Effect]) a.
(Exception e, ElaraDiagnostic e, Error ElaraError :> r) =>
Eff (Error e : r) a -> Eff r a
runErrorAsElaraError @CodeConverterError (Eff (Error CodeConverterError : es) [(String, LByteString)]
 -> Eff es [(String, LByteString)])
-> Eff (Error CodeConverterError : es) [(String, LByteString)]
-> Eff es [(String, LByteString)]
forall a b. (a -> b) -> a -> b
$ do
    classFiles <- Query [ClassFile]
-> Eff (Error CodeConverterError : es) [ClassFile]
forall (es :: [Effect]) (f :: * -> *) a.
(HasCallStack, QueryEffects es, Rock f :> es) =>
f a -> Eff es a
Rock.fetch (ModuleName -> Query [ClassFile]
GetJVMClassFiles ModuleName
mn)
    for classFiles $ \ClassFile
cf -> do
        bytes <- Either CodeConverterError LByteString
-> Eff (Error CodeConverterError : es) LByteString
forall e (r :: [Effect]) a.
(HasCallStack, Error e :> r, Show e) =>
Either e a -> Eff r a
fromEither (Either CodeConverterError LByteString
 -> Eff (Error CodeConverterError : es) LByteString)
-> Either CodeConverterError LByteString
-> Eff (Error CodeConverterError : es) LByteString
forall a b. (a -> b) -> a -> b
$ ClassFile -> Either CodeConverterError LByteString
classFileBytes ClassFile
cf
        pure (suitableFilePath cf.name, bytes)