{- | 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 Effectful.Error.Static (Error)
import H2JVM
import H2JVM.Name

import Effectful.Error.Extra (fromEither)
import Elara.AST.Name (ModuleName)
import Elara.JVM.Error (JVMLoweringError)
import Elara.JVM.Lower (lowerModule)
import Elara.Query (Query (..))
import Elara.Query.Effects (ConsQueryEffects)

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

-- | Lower a Core module to JVM IR
runGetJVMIRModuleQuery ::
    ModuleName ->
    Eff (ConsQueryEffects '[Error JVMLoweringError, Rock.Rock Query]) IR.Module
runGetJVMIRModuleQuery :: ModuleName
-> Eff
     (ConsQueryEffects '[Error JVMLoweringError, Rock Query]) Module
runGetJVMIRModuleQuery ModuleName
mn = do
    coreModule <- Query (Rock Query : ConsQueryEffects '[]) (CoreModule CoreBind)
-> Eff
     (ConsQueryEffects '[Error JVMLoweringError, Rock Query])
     (CoreModule CoreBind)
forall (xs :: [(* -> *) -> * -> *]) (es :: [(* -> *) -> * -> *])
       (f :: [(* -> *) -> * -> *] -> * -> *) a.
(Subset xs es, Rock f :> es, HasCallStack,
 StructuredDebug :> xs) =>
f xs a -> Eff es a
Rock.fetch (ModuleName
-> Query (Rock Query : ConsQueryEffects '[]) (CoreModule CoreBind)
GetFinalisedCoreModule ModuleName
mn)
    lowerModule coreModule

-- | Emit JVM IR to ClassFiles
runGetJVMClassFilesQuery ::
    ModuleName ->
    Eff (ConsQueryEffects '[Error JVMLoweringError, Rock.Rock Query]) [ClassFile]
runGetJVMClassFilesQuery :: ModuleName
-> Eff
     (ConsQueryEffects '[Error JVMLoweringError, Rock Query])
     [ClassFile]
runGetJVMClassFilesQuery ModuleName
mn = do
    irModule <- Query
  (Rock Query : ConsQueryEffects '[Error JVMLoweringError]) Module
-> Eff
     (ConsQueryEffects '[Error JVMLoweringError, Rock Query]) Module
forall (xs :: [(* -> *) -> * -> *]) (es :: [(* -> *) -> * -> *])
       (f :: [(* -> *) -> * -> *] -> * -> *) a.
(Subset xs es, Rock f :> es, HasCallStack,
 StructuredDebug :> xs) =>
f xs a -> Eff es a
Rock.fetch (ModuleName
-> Query
     (Rock Query : ConsQueryEffects '[Error JVMLoweringError]) Module
GetJVMIRModule ModuleName
mn)
    Emit.emitIRModule irModule

-- | Serialize ClassFiles to bytes with file paths
runGetJVMClassBytesQuery ::
    ModuleName ->
    Eff (ConsQueryEffects '[Error JVMLoweringError, Error CodeConverterError, Rock.Rock Query]) [(FilePath, LByteString)]
runGetJVMClassBytesQuery :: ModuleName
-> Eff
     (ConsQueryEffects
        '[Error JVMLoweringError, Error CodeConverterError, Rock Query])
     [(FilePath, LByteString)]
runGetJVMClassBytesQuery ModuleName
mn = do
    classFiles <- Query
  (Rock Query : ConsQueryEffects '[Error JVMLoweringError])
  [ClassFile]
-> Eff
     (ConsQueryEffects
        '[Error JVMLoweringError, Error CodeConverterError, Rock Query])
     [ClassFile]
forall (xs :: [(* -> *) -> * -> *]) (es :: [(* -> *) -> * -> *])
       (f :: [(* -> *) -> * -> *] -> * -> *) a.
(Subset xs es, Rock f :> es, HasCallStack,
 StructuredDebug :> xs) =>
f xs a -> Eff es a
Rock.fetch (ModuleName
-> Query
     (Rock Query : ConsQueryEffects '[Error JVMLoweringError])
     [ClassFile]
GetJVMClassFiles ModuleName
mn)
    for classFiles $ \ClassFile
cf -> do
        bytes <- Either CodeConverterError LByteString
-> Eff
     (ConsQueryEffects
        '[Error JVMLoweringError, Error CodeConverterError, Rock Query])
     LByteString
forall e (r :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> r, Show e) =>
Either e a -> Eff r a
fromEither (Either CodeConverterError LByteString
 -> Eff
      (ConsQueryEffects
         '[Error JVMLoweringError, Error CodeConverterError, Rock Query])
      LByteString)
-> Either CodeConverterError LByteString
-> Eff
     (ConsQueryEffects
        '[Error JVMLoweringError, Error CodeConverterError, Rock Query])
     LByteString
forall a b. (a -> b) -> a -> b
$ ClassFile -> Either CodeConverterError LByteString
classFileBytes ClassFile
cf
        pure (suitableFilePath cf.name, bytes)