{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE LambdaCase #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.StgToJS.Linker.Types
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Jeffrey Young  <jeffrey.young@iohk.io>
--                Luite Stegeman <luite.stegeman@iohk.io>
--                Sylvain Henry  <sylvain.henry@iohk.io>
--                Josh Meredith  <josh.meredith@iohk.io>
-- Stability   :  experimental
--
-----------------------------------------------------------------------------

module GHC.StgToJS.Linker.Types
  ( JSLinkConfig (..)
  , LinkPlan (..)
  )
where

import GHC.StgToJS.Object

import GHC.Unit.Types
import GHC.Utils.Outputable (Outputable(..),text,ppr, hang, IsDoc (vcat), IsLine (hcat))

import Data.Map.Strict      (Map)
import Data.Set             (Set)
import qualified Data.Set        as S

import System.IO

import Prelude

--------------------------------------------------------------------------------
-- Linker Config
--------------------------------------------------------------------------------

data JSLinkConfig = JSLinkConfig
  { JSLinkConfig -> Bool
lcNoJSExecutables :: !Bool         -- ^ Dont' build JS executables
  , JSLinkConfig -> Bool
lcNoHsMain        :: !Bool         -- ^ Don't generate Haskell main entry
  , JSLinkConfig -> Bool
lcNoRts           :: !Bool         -- ^ Don't dump the generated RTS
  , JSLinkConfig -> Bool
lcNoStats         :: !Bool         -- ^ Disable .stats file generation
  , JSLinkConfig -> Bool
lcForeignRefs     :: !Bool         -- ^ Dump .frefs (foreign references) files
  , JSLinkConfig -> Bool
lcCombineAll      :: !Bool         -- ^ Generate all.js (combined js) + wrappers
  , JSLinkConfig -> Bool
lcForceEmccRts    :: !Bool
      -- ^ Force the link with the emcc rts. Use this if you plan to dynamically
      -- load wasm modules made from C files (e.g. in iserv).
  , JSLinkConfig -> Bool
lcLinkCsources    :: !Bool
      -- ^ Link C sources (compiled to JS/Wasm) with Haskell code compiled to
      -- JS. This implies the use of the Emscripten RTS to load this code.
  }

data LinkPlan = LinkPlan
  { LinkPlan -> Map Module LocatedBlockInfo
lkp_block_info :: Map Module LocatedBlockInfo
      -- ^ Block information

  , LinkPlan -> Set BlockRef
lkp_dep_blocks :: Set BlockRef
      -- ^ Blocks to link

  , LinkPlan -> Set FilePath
lkp_archives   :: !(Set FilePath)
      -- ^ Archives to load JS and Cc sources from (JS code corresponding to
      -- Haskell code is handled with blocks above)

  , LinkPlan -> Set FilePath
lkp_objs_js   :: !(Set FilePath)
      -- ^ JS objects to link

  , LinkPlan -> Set FilePath
lkp_objs_cc   :: !(Set FilePath)
      -- ^ Cc objects to link
  }

instance Outputable LinkPlan where
  ppr :: LinkPlan -> SDoc
ppr LinkPlan
s = SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"LinkPlan") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
            -- Hidden because it's too verbose and it's not really part of the
            -- plan, just meta info used to retrieve actual block contents
            -- [ hcat [ text "Block info: ", ppr (lkp_block_info s)]
            [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Blocks: ", Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Set BlockRef -> Int
forall a. Set a -> Int
S.size (LinkPlan -> Set BlockRef
lkp_dep_blocks LinkPlan
s))]
            , SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Archives:") Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (Set FilePath -> [FilePath]
forall a. Set a -> [a]
S.toList (LinkPlan -> Set FilePath
lkp_archives LinkPlan
s))))
            , SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Extra JS objects:") Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (Set FilePath -> [FilePath]
forall a. Set a -> [a]
S.toList (LinkPlan -> Set FilePath
lkp_objs_js LinkPlan
s))))
            , SDoc -> Int -> SDoc -> SDoc
hang (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Extra Cc objects:") Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (Set FilePath -> [FilePath]
forall a. Set a -> [a]
S.toList (LinkPlan -> Set FilePath
lkp_objs_cc LinkPlan
s))))
            ]