IncludeGraph.hs

-- | @hs-bindgen-cli info include-graph@ command
--
-- Intended for qualified import.
--
-- > import HsBindgen.Cli.Info.IncludeGraph qualified as IncludeGraph
module HsBindgen.Cli.Info.IncludeGraph (
    -- * CLI help
    info
    -- * Options
  , Opts(..)
  , parseOpts
    -- * Execution
  , exec
  ) where

import Data.Either (partitionEithers)
import Options.Applicative hiding (info)

import HsBindgen
import HsBindgen.App
import HsBindgen.ArtefactM
import HsBindgen.Backend.Category
import HsBindgen.Config
import HsBindgen.Config.Internal (BindgenConfig)
import HsBindgen.Frontend.Analysis.IncludeGraph (HeaderLabelStyle (..),
                                                 IncludeGraphFormat (..))
import HsBindgen.Frontend.Predicate
import HsBindgen.Imports
import HsBindgen.IR.C qualified as C
import HsBindgen.Macro

{-------------------------------------------------------------------------------
  CLI help
-------------------------------------------------------------------------------}

info :: InfoMod a
info = progDesc "Output the include graph"

{-------------------------------------------------------------------------------
  Options
-------------------------------------------------------------------------------}

data Opts = Opts {
      config         :: Config
    , predicate      :: Boolean Regex
    , labelStyle     :: HeaderLabelStyle
    , format         :: IncludeGraphFormat
    , output         :: Maybe FilePath
    , inputs         :: [C.UncheckedRootDirective]
    , filePolicy     :: FilePolicy
    , dirPolicy      :: DirPolicy
    }

parseOpts :: Parser Opts
parseOpts =
    Opts
      <$> parseConfig
      <*> parsePredicate
      <*> parseHeaderLabelStyle
      <*> parseIncludeGraphFormat
      <*> optional parseOutput'
      <*> parseInputs
      <*> parseFilePolicy
      <*> parseDirPolicy

parsePredicate :: Parser (Boolean Regex)
parsePredicate = fmap merge . many . asum $ [
      fmap (Right . BIf) $ strOption $ mconcat [
          long "include"
        , metavar "PCRE"
        , help "Only include headers with paths that match PCRE (by default, include all)"
        ]
    , fmap (Left . BIf) $ strOption $ mconcat [
          long "exclude"
        , metavar "PCRE"
        , help "Exclude headers with paths that match PCRE"
        ]
    ]
  where
    merge :: Eq a => [Either (Boolean a) (Boolean a)] -> Boolean a
    merge = uncurry mergeBooleans . fmap defaultIncludeAll . partitionEithers

    defaultIncludeAll :: [Boolean a] -> [Boolean a]
    defaultIncludeAll = \case
      [] -> [BTrue]
      xs -> xs

parseHeaderLabelStyle :: Parser HeaderLabelStyle
parseHeaderLabelStyle = flag ShowIncludeArgs ShowPaths $ mconcat [
      long "show-paths"
    , help "Show paths of include header files instead of their '#include' arguments"
    ]

parseIncludeGraphFormat :: Parser IncludeGraphFormat
parseIncludeGraphFormat = flag Mermaid SortedList $ mconcat [
      long "toposort"
    , help "Output a topologically sorted list of headers instead of a Mermaid graph"
    ]

parseOutput' :: Parser FilePath
parseOutput' = strOption $ mconcat [
      short 'o'
    , long "output"
    , metavar "PATH"
    , help "Output path for the graph"
    ]

{-------------------------------------------------------------------------------
  Execution
-------------------------------------------------------------------------------}

exec :: GlobalOpts -> Opts -> IO ()
exec global opts =
    hsBindgen
      global.unsafe
      global.safe
      bindgenConfig
      opts.inputs
      artefact
  where
    artefact :: Artefact CExpr ()
    artefact =
      writeIncludeGraph
        opts.predicate
        opts.labelStyle
        opts.format
        opts.filePolicy
        opts.dirPolicy
        opts.output

    bindgenConfig :: BindgenConfig
    bindgenConfig =
        toBindgenConfig
          opts.config
          (UniqueId       "unused-unique-id")
          (BaseModuleName "unused-module-name")
          (def :: ByCategory Choice)