{-# 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 (..)
  , defaultJSLinkConfig
  , LinkedObj (..)
  , LinkPlan (..)
  )
where

import GHC.StgToJS.Object

import GHC.Unit.Types
import GHC.Utils.Outputable (hsep,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
  }

-- | Default linker configuration
defaultJSLinkConfig :: JSLinkConfig
defaultJSLinkConfig :: JSLinkConfig
defaultJSLinkConfig = JSLinkConfig
  { lcNoJSExecutables :: Bool
lcNoJSExecutables = Bool
False
  , lcNoHsMain :: Bool
lcNoHsMain        = Bool
False
  , lcNoRts :: Bool
lcNoRts           = Bool
False
  , lcNoStats :: Bool
lcNoStats         = Bool
False
  , lcCombineAll :: Bool
lcCombineAll      = Bool
True
  , lcForeignRefs :: Bool
lcForeignRefs     = Bool
True
  }

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 sources from

  , LinkPlan -> Set FilePath
lkp_extra_js   :: Set FilePath
      -- ^ Extra JS files 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
"JS files from 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:") 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_extra_js LinkPlan
s))))
            ]

--------------------------------------------------------------------------------
-- Linker Environment
--------------------------------------------------------------------------------

-- | An object file that's either already in memory (with name) or on disk
data LinkedObj
  = ObjFile   FilePath      -- ^ load from this file
  | ObjLoaded String Object -- ^ already loaded: description and payload

instance Outputable LinkedObj where
  ppr :: LinkedObj -> SDoc
ppr = \case
    ObjFile FilePath
fp    -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"ObjFile", FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
fp]
    ObjLoaded FilePath
s Object
o -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"ObjLoaded", FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
s, ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Object -> ModuleName
objModuleName Object
o)]