module HsBindgen.Config.Prelims (
    -- * Base module name
    BaseModuleName(..)
  , baseModuleNameToString
  , fromBaseModuleName

    -- * Field naming strategy
  , FieldNamingStrategy(..)

    -- * Unique IDs
  , UniqueId (..)
  , UniqueIdMsg (..)
  ) where

import Data.Text qualified as Text
import Text.SimplePrettyPrint qualified as PP

import HsBindgen.Backend.Category
import HsBindgen.Imports
import HsBindgen.Language.Haskell qualified as Hs
import HsBindgen.Util.Tracer

{-------------------------------------------------------------------------------
  Base module name
-------------------------------------------------------------------------------}

-- | Base module name from which other module names are derived
--
-- For example, the base module name might be @Generated@, from which we
-- derive @Generated@, @Generated.Safe@, etc.
newtype BaseModuleName = BaseModuleName { text :: Text }
  deriving stock (Eq, Generic)
  deriving newtype (IsString, Show)

instance Default BaseModuleName where
  def = "Generated"

baseModuleNameToString :: BaseModuleName -> String
baseModuleNameToString baseModule = Text.unpack baseModule.text

fromBaseModuleName :: BaseModuleName -> Maybe Category -> Hs.ModuleName
fromBaseModuleName (BaseModuleName base) Nothing =
    Hs.ModuleName base
fromBaseModuleName (BaseModuleName base) (Just CType) =
    Hs.ModuleName base
fromBaseModuleName (BaseModuleName base) (Just (CTerm cat)) =
    Hs.ModuleName (base <> "." <> submodule cat)
  where
    -- NOTE: It is important that types are stored in a module without any
    -- suffix; we depend on this assumption for binding specifications (which
    -- only refer to types, never to functions or globals).
    submodule :: TermCategory -> Text
    submodule CSafe   = "Safe"
    submodule CUnsafe = "Unsafe"
    submodule CFunPtr = "FunPtr"
    submodule CGlobal = "Global"

{-------------------------------------------------------------------------------
  Field naming strategy
-------------------------------------------------------------------------------}

-- | Strategy for naming struct\/union fields.
--
-- With 'PrefixedFieldNames' (the default), field names are prefixed with the
-- struct name to avoid name collisions (e.g., @timeval_tv_sec@).
--
-- With 'EnableRecordDot', field names are not prefixed (e.g., @tv_sec@).
-- This enables the @DuplicateRecordFields@ GHC extension, which is
-- automatically added when this strategy is selected. As the name suggests
-- this enables the user to use @OverloadedRecordDot@ GHC extension.
--
data FieldNamingStrategy =
    PrefixedFieldNames
  | EnableRecordDot
  deriving stock (Show, Eq, Generic)

instance Default FieldNamingStrategy where
  def = PrefixedFieldNames

{-------------------------------------------------------------------------------
  Unique IDs
-------------------------------------------------------------------------------}

-- | C uses a global namespace. We must ensure that identifiers generated by
-- @hs-bindgen@ are unique.
--
-- Defaults to the empty string @'UniqueId' ""@, which is __suboptimal__. We
-- encourage using unique identifiers such as
-- "com.well-typed.your-package-name".
data UniqueId = UniqueId { unUniqueId :: String }
  deriving stock (Show, Eq, Ord)

instance Default UniqueId where
  def = UniqueId ""

data UniqueIdMsg =
    UniqueIdEmpty
  deriving (Show, Eq, Ord)

instance PrettyForTrace UniqueIdMsg where
  prettyForTrace = \case
    UniqueIdEmpty -> PP.vcat [
        "empty unique identifier ('UniqueId', '--unique-id'):"
      , "  C uses a global namespace."
      , "  We encourage using a unique identifier to avoid duplicate symbol names."
      , "  For example, use and adapt 'com.example.package'."
      ]

instance IsTrace Level UniqueIdMsg where
  getDefaultLogLevel = \case
    UniqueIdEmpty     -> Warning
  getSource  = const HsBindgen
  getTraceId = const "unique-id"