-- This file is part of Hoppy.
--
-- Copyright 2015-2021 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | Interface for defining bindings to C++ variables.
module Foreign.Hoppy.Generator.Spec.Variable (
  -- * Data type
  Variable,
  -- * Construction
  makeVariable,
  -- * Properties
  varExtName,
  varIdentifier,
  varType,
  varReqs,
  varAddendum,
  varIsConst,
  varGetterExtName,
  varSetterExtName,
  ) where

import Data.Function (on)
import Foreign.Hoppy.Generator.Spec.Base
import qualified Foreign.Hoppy.Generator.Spec.Class as Class
import qualified Foreign.Hoppy.Generator.Language.Cpp as LC
import qualified Foreign.Hoppy.Generator.Language.Haskell as LH

-- | A C++ variable.
--
-- Use this data type's 'HasReqs' instance to make the variable accessible.
data Variable = Variable
  { Variable -> Identifier
varIdentifier :: Identifier
    -- ^ The identifier used to refer to the variable.
  , Variable -> ExtName
varExtName :: ExtName
    -- ^ The variable's external name.
  , Variable -> Type
varType :: Type
    -- ^ The variable's type.  This may be
    -- 'Foreign.Hoppy.Generator.Types.constT' to indicate that the variable is
    -- read-only.
  , Variable -> Reqs
varReqs :: Reqs
    -- ^ Requirements for bindings to access this variable.
  , Variable -> Addendum
varAddendum :: Addendum
    -- ^ The variable's addendum.
  }

instance Eq Variable where
  == :: Variable -> Variable -> Bool
(==) = ExtName -> ExtName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ExtName -> ExtName -> Bool)
-> (Variable -> ExtName) -> Variable -> Variable -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Variable -> ExtName
varExtName

instance Show Variable where
  show :: Variable -> String
show Variable
v = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<Variable ", ExtName -> String
forall a. Show a => a -> String
show (Variable -> ExtName
varExtName Variable
v), String
" ", Type -> String
forall a. Show a => a -> String
show (Variable -> Type
varType Variable
v), String
">"]

instance Exportable Variable where
  sayExportCpp :: SayExportMode -> Variable -> Generator ()
sayExportCpp = SayExportMode -> Variable -> Generator ()
sayCppExport
  sayExportHaskell :: SayExportMode -> Variable -> Generator ()
sayExportHaskell = SayExportMode -> Variable -> Generator ()
sayHsExport

instance HasExtNames Variable where
  getPrimaryExtName :: Variable -> ExtName
getPrimaryExtName = Variable -> ExtName
varExtName
  getNestedExtNames :: Variable -> [ExtName]
getNestedExtNames Variable
v = [Variable -> ExtName
varGetterExtName Variable
v, Variable -> ExtName
varSetterExtName Variable
v]

instance HasReqs Variable where
  getReqs :: Variable -> Reqs
getReqs = Variable -> Reqs
varReqs
  setReqs :: Reqs -> Variable -> Variable
setReqs Reqs
reqs Variable
v = Variable
v { varReqs :: Reqs
varReqs = Reqs
reqs }

instance HasAddendum Variable where
  getAddendum :: Variable -> Addendum
getAddendum = Variable -> Addendum
varAddendum
  setAddendum :: Addendum -> Variable -> Variable
setAddendum Addendum
addendum Variable
v = Variable
v { varAddendum :: Addendum
varAddendum = Addendum
addendum }

-- | Creates a binding for a C++ variable.
makeVariable :: Identifier -> Maybe ExtName -> Type -> Variable
makeVariable :: Identifier -> Maybe ExtName -> Type -> Variable
makeVariable Identifier
identifier Maybe ExtName
maybeExtName Type
t =
  Identifier -> ExtName -> Type -> Reqs -> Addendum -> Variable
Variable Identifier
identifier (HasCallStack => Identifier -> Maybe ExtName -> ExtName
Identifier -> Maybe ExtName -> ExtName
extNameOrIdentifier Identifier
identifier Maybe ExtName
maybeExtName) Type
t Reqs
forall a. Monoid a => a
mempty Addendum
forall a. Monoid a => a
mempty

-- | Returns whether the variable is constant, i.e. whether its type is
-- @'Foreign.Hoppy.Generator.Types.constT' ...@.
varIsConst :: Variable -> Bool
varIsConst :: Variable -> Bool
varIsConst Variable
v = case Variable -> Type
varType Variable
v of
  Internal_TConst Type
_ -> Bool
True
  Type
_ -> Bool
False

-- | Returns the external name of the getter function for the variable.
varGetterExtName :: Variable -> ExtName
varGetterExtName :: Variable -> ExtName
varGetterExtName = HasCallStack => String -> ExtName
String -> ExtName
toExtName (String -> ExtName) -> (Variable -> String) -> Variable -> ExtName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_get") ShowS -> (Variable -> String) -> Variable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtName -> String
fromExtName (ExtName -> String) -> (Variable -> ExtName) -> Variable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> ExtName
varExtName

-- | Returns the external name of the setter function for the variable.
varSetterExtName :: Variable -> ExtName
varSetterExtName :: Variable -> ExtName
varSetterExtName = HasCallStack => String -> ExtName
String -> ExtName
toExtName (String -> ExtName) -> (Variable -> String) -> Variable -> ExtName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_set") ShowS -> (Variable -> String) -> Variable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtName -> String
fromExtName (ExtName -> String) -> (Variable -> ExtName) -> Variable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> ExtName
varExtName

sayCppExport :: LC.SayExportMode -> Variable -> LC.Generator ()
sayCppExport :: SayExportMode -> Variable -> Generator ()
sayCppExport SayExportMode
mode Variable
v = case SayExportMode
mode of
  SayExportMode
LC.SayHeader -> () -> Generator ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  SayExportMode
LC.SaySource ->
    Type
-> Maybe (Type, Type)
-> Bool
-> ExtName
-> ExtName
-> Generator ()
-> Generator ()
Class.sayCppExportVar (Variable -> Type
varType Variable
v)
                          Maybe (Type, Type)
forall a. Maybe a
Nothing
                          Bool
True
                          (Variable -> ExtName
varGetterExtName Variable
v)
                          (Variable -> ExtName
varSetterExtName Variable
v)
                          (Identifier -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => Identifier -> m ()
LC.sayIdentifier (Identifier -> Generator ()) -> Identifier -> Generator ()
forall a b. (a -> b) -> a -> b
$ Variable -> Identifier
varIdentifier Variable
v)

sayHsExport :: LH.SayExportMode -> Variable -> LH.Generator ()
sayHsExport :: SayExportMode -> Variable -> Generator ()
sayHsExport SayExportMode
mode Variable
v = String -> Generator () -> Generator ()
forall a. String -> Generator a -> Generator a
LH.withErrorContext (String
"generating variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> String
forall a. Show a => a -> String
show (Variable -> ExtName
varExtName Variable
v)) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
  let getterName :: ExtName
getterName = Variable -> ExtName
varGetterExtName Variable
v
      setterName :: ExtName
setterName = Variable -> ExtName
varSetterExtName Variable
v
  SayExportMode
-> Type
-> Maybe Class
-> Bool
-> ExtName
-> ExtName
-> ExtName
-> ExtName
-> Generator ()
Class.sayHsExportVar SayExportMode
mode
                       (Variable -> Type
varType Variable
v)
                       Maybe Class
forall a. Maybe a
Nothing
                       Bool
True
                       ExtName
getterName
                       ExtName
getterName
                       ExtName
setterName
                       ExtName
setterName