{-# LANGUAGE DeriveGeneric #-}
module FFICXX.Generate.Type.Config where

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


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
showList :: [ModuleUnit] -> ShowS
$cshowList :: [ModuleUnit] -> ShowS
show :: ModuleUnit -> String
$cshow :: ModuleUnit -> String
showsPrec :: Int -> ModuleUnit -> ShowS
$cshowsPrec :: Int -> ModuleUnit -> ShowS
Show,ModuleUnit -> ModuleUnit -> Bool
(ModuleUnit -> ModuleUnit -> Bool)
-> (ModuleUnit -> ModuleUnit -> Bool) -> Eq ModuleUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleUnit -> ModuleUnit -> Bool
$c/= :: ModuleUnit -> ModuleUnit -> Bool
== :: ModuleUnit -> ModuleUnit -> Bool
$c== :: 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
$cto :: forall x. Rep ModuleUnit x -> ModuleUnit
$cfrom :: forall x. ModuleUnit -> Rep ModuleUnit x
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
showList :: [ModuleUnitImports] -> ShowS
$cshowList :: [ModuleUnitImports] -> ShowS
show :: ModuleUnitImports -> String
$cshow :: ModuleUnitImports -> String
showsPrec :: Int -> ModuleUnitImports -> ShowS
$cshowsPrec :: Int -> 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 :: [Namespace] -> [HeaderName] -> ModuleUnitImports
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
    }
  )