-- | General Haskell language types
--
-- Intended for qualified import.
--
-- > import HsBindgen.Language.Haskell qualified as Hs
module HsBindgen.Language.Haskell (
    -- * Module names
    ModuleName(..)
  , moduleNameFromString
  , moduleNameToString
  , moduleNamePath
    -- * References
  , Identifier(..)
  , ExtRef(..)
  , Ref(..)
    -- * Namespaced names
  , Namespace(..)
  , SNamespace(..)
  , namespaceOf
  , SingNamespace(..)
  ) where

import Data.Foldable qualified as Foldable
import Data.Text qualified as Text
import System.FilePath
import Text.SimplePrettyPrint qualified as PP

import HsBindgen.Imports
import HsBindgen.Util.Tracer

{-------------------------------------------------------------------------------
  Module names
-------------------------------------------------------------------------------}

-- | Haskell module name
--
-- Example: @HsBindgen.Runtime.LibC@
newtype ModuleName = ModuleName { text :: Text }
  deriving stock (Generic)
  -- 'Show' instance valid due to 'IsString' instance
  deriving newtype (Eq, IsString, Ord, Show)

moduleNameFromString :: String -> ModuleName
moduleNameFromString = ModuleName . Text.pack

moduleNameToString :: ModuleName -> String
moduleNameToString moduleName = Text.unpack moduleName.text

moduleNamePath :: ModuleName -> FilePath
moduleNamePath moduleName = withoutExt <.> "hs"
  where
    withoutExt :: FilePath
    withoutExt =
        Foldable.foldl' (</>) "" $
          map Text.unpack (Text.splitOn "." moduleName.text)

instance PrettyForTrace ModuleName where
  prettyForTrace moduleName = PP.text moduleName.text

{-------------------------------------------------------------------------------
  References
-------------------------------------------------------------------------------}

-- | Haskell identifier
--
-- Example: @Tm@
--
-- This type is used to reference Haskell types, constructors, fields, etc.  It
-- does /not/ specify a 'Namespace' like the 'Name' type below.
newtype Identifier = Identifier { text :: Text }
  deriving stock (Eq, Ord, Generic)
  -- 'Show' instance valid due to 'IsString' instance
  deriving newtype (IsString, Show, Semigroup)

instance PrettyForTrace Identifier where
  prettyForTrace ident = PP.text ident.text

-- | External reference
--
-- An external reference specifies the 'ModuleName' and 'Identifier'
data ExtRef = ExtRef {
      moduleName :: ModuleName
    , ident      :: Identifier
    }
  deriving stock (Eq, Generic, Ord, Show)

-- | Reference
data Ref =
    -- | Reference to an identifier in the local scope
    RefLocal Identifier

  | -- | Reference to an identifier in a different module
    RefExt ExtRef
  deriving stock (Eq, Show)

{-------------------------------------------------------------------------------
  Namespaced names
-------------------------------------------------------------------------------}

-- | Namespace
--
-- See section 1.4, "Namespaces" of the Haskell report
-- <https://www.haskell.org/onlinereport/haskell2010/haskellch1.html#x6-130001.4>
data Namespace =
    NsTypeConstr
  | NsConstr
  | NsVar
  deriving (Eq, Ord, Show)

-- | Namespace singleton
data SNamespace :: Namespace -> Star where
  SNsTypeConstr :: SNamespace 'NsTypeConstr
  SNsConstr     :: SNamespace 'NsConstr
  SNsVar        :: SNamespace 'NsVar

-- | Get the namespace of a namespace singleton
namespaceOf :: SNamespace ns -> Namespace
namespaceOf = \case
    SNsTypeConstr -> NsTypeConstr
    SNsConstr     -> NsConstr
    SNsVar        -> NsVar

-- | Namespace singleton class
class SingNamespace ns where
  singNamespace :: SNamespace ns

instance SingNamespace 'NsTypeConstr where singNamespace = SNsTypeConstr
instance SingNamespace 'NsConstr     where singNamespace = SNsConstr
instance SingNamespace 'NsVar        where singNamespace = SNsVar