-- This file is part of Hoppy.
--
-- Copyright 2015-2021 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP #-}

-- | Internal portion of the C++ code generator.
module Foreign.Hoppy.Generator.Language.Cpp.Internal (
  Generation,
  generate,
  generatedFiles,
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (when)
import Control.Monad.Writer (execWriterT, tell)
import Control.Monad.Trans (lift)
import Data.Foldable (forM_)
#if !MIN_VERSION_base(4,8,0)
import Data.Functor ((<$))
#endif
import qualified Data.Map as M
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mappend, mconcat, mempty)
#endif
import Foreign.Hoppy.Generator.Common
import Foreign.Hoppy.Generator.Language.Cpp
import Foreign.Hoppy.Generator.Spec
import Foreign.Hoppy.Generator.Types

-- | The in-memory result of generating C++ code for an interface.
newtype Generation = Generation
  { Generation -> Map FilePath FilePath
generatedFiles :: M.Map FilePath String
    -- ^ A map from paths of generated files to the contents of those files.
    -- The file paths are relative paths below the C++ generation root.
  }

-- | Runs the C++ code generator against an interface.
generate :: Interface -> ComputedInterfaceData -> Either ErrorMsg Generation
generate :: Interface -> ComputedInterfaceData -> Either FilePath Generation
generate Interface
iface ComputedInterfaceData
computed =
  ([(FilePath, FilePath)] -> Generation)
-> Either FilePath [(FilePath, FilePath)]
-> Either FilePath Generation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map FilePath FilePath -> Generation
Generation (Map FilePath FilePath -> Generation)
-> ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)]
-> Generation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) (Either FilePath [(FilePath, FilePath)]
 -> Either FilePath Generation)
-> Either FilePath [(FilePath, FilePath)]
-> Either FilePath Generation
forall a b. (a -> b) -> a -> b
$
  WriterT [(FilePath, FilePath)] (Either FilePath) ()
-> Either FilePath [(FilePath, FilePath)]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT [(FilePath, FilePath)] (Either FilePath) ()
 -> Either FilePath [(FilePath, FilePath)])
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
-> Either FilePath [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$
  [Module]
-> (Module -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map FilePath Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Map FilePath Module -> [Module])
-> Map FilePath Module -> [Module]
forall a b. (a -> b) -> a -> b
$ Interface -> Map FilePath Module
interfaceModules Interface
iface) ((Module -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
 -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> (Module -> WriterT [(FilePath, FilePath)] (Either FilePath) ())
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> do
    let headerGuard :: FilePath
headerGuard = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"HOPPY_MODULE_", Interface -> FilePath
interfaceName Interface
iface, FilePath
"_", Module -> FilePath
moduleName Module
m]
    FilePath
header <- Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either FilePath FilePath
 -> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath)
-> Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall a b. (a -> b) -> a -> b
$ Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator ()
-> Either FilePath FilePath
forall a.
Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator a
-> Either FilePath FilePath
execGenerator Interface
iface ComputedInterfaceData
computed Module
m (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
headerGuard) Generator ()
sayModuleHeader
    [(FilePath, FilePath)]
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Module -> FilePath
moduleHppPath Module
m, FilePath
header)]
    FilePath
source <- Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either FilePath FilePath
 -> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath)
-> Either FilePath FilePath
-> WriterT [(FilePath, FilePath)] (Either FilePath) FilePath
forall a b. (a -> b) -> a -> b
$ Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator ()
-> Either FilePath FilePath
forall a.
Interface
-> ComputedInterfaceData
-> Module
-> Maybe FilePath
-> Generator a
-> Either FilePath FilePath
execGenerator Interface
iface ComputedInterfaceData
computed Module
m Maybe FilePath
forall a. Maybe a
Nothing Generator ()
sayModuleSource
    [(FilePath, FilePath)]
-> WriterT [(FilePath, FilePath)] (Either FilePath) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(Module -> FilePath
moduleCppPath Module
m, FilePath
source)]

sayModuleHeader :: Generator ()
sayModuleHeader :: Generator ()
sayModuleHeader = do
  Module
m <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Module
forall (m :: * -> *). MonadReader Env m => m Module
askModule
  Reqs -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => Reqs -> m ()
addReqsM (Reqs -> Generator ()) -> Reqs -> Generator ()
forall a b. (a -> b) -> a -> b
$ Module -> Reqs
moduleReqs Module
m
  (Export -> Generator ()) -> [Export] -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SayExportMode -> Export -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportCpp SayExportMode
SayHeader) ([Export] -> Generator ()) -> [Export] -> Generator ()
forall a b. (a -> b) -> a -> b
$ Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems (Map ExtName Export -> [Export]) -> Map ExtName Export -> [Export]
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m

  Interface
iface <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
  Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Interface -> Maybe Module
interfaceExceptionSupportModule Interface
iface Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
    Bool -> Generator ()
sayExceptionSupport Bool
False

sayModuleSource :: Generator ()
sayModuleSource :: Generator ()
sayModuleSource = do
  Module
m <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Module
forall (m :: * -> *). MonadReader Env m => m Module
askModule
  Include -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => Include -> m ()
addInclude (Include -> Generator ()) -> Include -> Generator ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Include
includeLocal (FilePath -> Include) -> FilePath -> Include
forall a b. (a -> b) -> a -> b
$ Module -> FilePath
moduleHppPath Module
m
  (Export -> Generator ()) -> [Export] -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SayExportMode -> Export -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportCpp SayExportMode
SaySource) ([Export] -> Generator ()) -> [Export] -> Generator ()
forall a b. (a -> b) -> a -> b
$ Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems (Map ExtName Export -> [Export]) -> Map ExtName Export -> [Export]
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m

  Interface
iface <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
  Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Interface -> Maybe Module
interfaceExceptionSupportModule Interface
iface Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
    Bool -> Generator ()
sayExceptionSupport Bool
True

-- | Outputs interface-wide code needed to support exceptions.  Currently, this
-- comprises the function for rethrowing in C++ an exception transferred from
-- a foreign language.
sayExceptionSupport :: Bool -> Generator ()
sayExceptionSupport :: Bool -> Generator ()
sayExceptionSupport Bool
sayBody =
  FilePath
-> [FilePath] -> Type -> Maybe (Generator ()) -> Generator ()
sayFunction FilePath
exceptionRethrowFnName
              [FilePath
"excId", FilePath
"voidPtr"]
              ([Type] -> Type -> Type
fnT [Type
intT, Type -> Type
ptrT Type
voidT] Type
voidT) (Maybe (Generator ()) -> Generator ())
-> Maybe (Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$
  if Bool -> Bool
not Bool
sayBody
  then Maybe (Generator ())
forall a. Maybe a
Nothing
  else Generator () -> Maybe (Generator ())
forall a. a -> Maybe a
Just (Generator () -> Maybe (Generator ()))
-> Generator () -> Maybe (Generator ())
forall a b. (a -> b) -> a -> b
$ do
    Interface
iface <- ReaderT Env (WriterT [Chunk] (Either FilePath)) Interface
forall (m :: * -> *). MonadReader Env m => m Interface
askInterface
    let excClasses :: [Class]
excClasses = Interface -> [Class]
interfaceAllExceptionClasses Interface
iface

    [FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
"switch (excId) {\n"]

    [Class] -> (Class -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Class]
excClasses ((Class -> Generator ()) -> Generator ())
-> (Class -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \Class
cls -> do
      Int
excId <- (ExceptionId -> Int)
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExceptionId -> Int
getExceptionId (ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
 -> ReaderT Env (WriterT [Chunk] (Either FilePath)) Int)
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) Int
forall a b. (a -> b) -> a -> b
$
               ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
-> Maybe ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (FilePath
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall a. FilePath -> Generator a
abort (FilePath
 -> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId)
-> FilePath
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall a b. (a -> b) -> a -> b
$ FilePath
"sayExceptionSupport: Internal error, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Class -> FilePath
forall a. Show a => a -> FilePath
show Class
cls FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                           FilePath
"should have an exception ID, but doesn't.") (Maybe ExceptionId
 -> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId)
-> Maybe ExceptionId
-> ReaderT Env (WriterT [Chunk] (Either FilePath)) ExceptionId
forall a b. (a -> b) -> a -> b
$
               Interface -> Class -> Maybe ExceptionId
interfaceExceptionClassId Interface
iface Class
cls
      [FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
"case ", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
excId, FilePath
": {\n"]
      FilePath -> Maybe [FilePath] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
FilePath -> Maybe [FilePath] -> Type -> m ()
sayVar FilePath
"excPtr" Maybe [FilePath]
forall a. Maybe a
Nothing (Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls) Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
" = reinterpret_cast<" Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        Maybe [FilePath] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Maybe [FilePath] -> Type -> m ()
sayType Maybe [FilePath]
forall a. Maybe a
Nothing (Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls) Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
">(voidPtr);\n"]
      FilePath -> Maybe [FilePath] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
FilePath -> Maybe [FilePath] -> Type -> m ()
sayVar FilePath
"exc" Maybe [FilePath]
forall a. Maybe a
Nothing (Class -> Type
objT Class
cls) Generator () -> Generator () -> Generator ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
" = *excPtr;\n"
      FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"delete excPtr;\n"
      FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"throw exc;\n"
      FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"}\n"

    FilePath -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => FilePath -> m ()
say FilePath
"}\n"
    [FilePath] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [FilePath] -> m ()
says [FilePath
"throw \"Internal Hoppy error, ", FilePath
exceptionRethrowFnName,
          FilePath
" got an unknown exception ID.\";\n"]