{-# LANGUAGE DeriveGeneric #-}

module FFICXX.Generate.Type.Config where

import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable (..))
--
import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..), Namespace (..))
import GHC.Generics (Generic)

data ModuleUnit
  = MU_TopLevel
  | MU_Class String
  deriving (Int -> ModuleUnit -> ShowS
[ModuleUnit] -> ShowS
ModuleUnit -> String
(Int -> ModuleUnit -> ShowS)
-> (ModuleUnit -> String)
-> ([ModuleUnit] -> ShowS)
-> Show ModuleUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleUnit -> ShowS
showsPrec :: Int -> ModuleUnit -> ShowS
$cshow :: ModuleUnit -> String
show :: ModuleUnit -> String
$cshowList :: [ModuleUnit] -> ShowS
showList :: [ModuleUnit] -> ShowS
Show, ModuleUnit -> ModuleUnit -> Bool
(ModuleUnit -> ModuleUnit -> Bool)
-> (ModuleUnit -> ModuleUnit -> Bool) -> Eq ModuleUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleUnit -> ModuleUnit -> Bool
== :: ModuleUnit -> ModuleUnit -> Bool
$c/= :: ModuleUnit -> ModuleUnit -> Bool
/= :: ModuleUnit -> ModuleUnit -> Bool
Eq, (forall x. ModuleUnit -> Rep ModuleUnit x)
-> (forall x. Rep ModuleUnit x -> ModuleUnit) -> Generic ModuleUnit
forall x. Rep ModuleUnit x -> ModuleUnit
forall x. ModuleUnit -> Rep ModuleUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModuleUnit -> Rep ModuleUnit x
from :: forall x. ModuleUnit -> Rep ModuleUnit x
$cto :: forall x. Rep ModuleUnit x -> ModuleUnit
to :: forall x. Rep ModuleUnit x -> ModuleUnit
Generic)

instance Hashable ModuleUnit

data ModuleUnitImports = ModuleUnitImports
  { ModuleUnitImports -> [Namespace]
muimports_namespaces :: [Namespace],
    ModuleUnitImports -> [HeaderName]
muimports_headers :: [HeaderName]
  }
  deriving (Int -> ModuleUnitImports -> ShowS
[ModuleUnitImports] -> ShowS
ModuleUnitImports -> String
(Int -> ModuleUnitImports -> ShowS)
-> (ModuleUnitImports -> String)
-> ([ModuleUnitImports] -> ShowS)
-> Show ModuleUnitImports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleUnitImports -> ShowS
showsPrec :: Int -> ModuleUnitImports -> ShowS
$cshow :: ModuleUnitImports -> String
show :: ModuleUnitImports -> String
$cshowList :: [ModuleUnitImports] -> ShowS
showList :: [ModuleUnitImports] -> ShowS
Show)

emptyModuleUnitImports :: ModuleUnitImports
emptyModuleUnitImports = [Namespace] -> [HeaderName] -> ModuleUnitImports
ModuleUnitImports [] []

newtype ModuleUnitMap = ModuleUnitMap {ModuleUnitMap -> HashMap ModuleUnit ModuleUnitImports
unModuleUnitMap :: HashMap ModuleUnit ModuleUnitImports}

modImports ::
  String ->
  [String] ->
  [HeaderName] ->
  (ModuleUnit, ModuleUnitImports)
modImports :: String
-> [String] -> [HeaderName] -> (ModuleUnit, ModuleUnitImports)
modImports String
n [String]
ns [HeaderName]
hs =
  ( String -> ModuleUnit
MU_Class String
n,
    ModuleUnitImports
      { muimports_namespaces :: [Namespace]
muimports_namespaces = (String -> Namespace) -> [String] -> [Namespace]
forall a b. (a -> b) -> [a] -> [b]
map String -> Namespace
NS [String]
ns,
        muimports_headers :: [HeaderName]
muimports_headers = [HeaderName]
hs
      }
  )