-- 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/>.

{-# LANGUAGE CPP #-}

-- | Bindings for common class operations, such as copy construction.
module Foreign.Hoppy.Generator.Spec.ClassFeature (
  -- * Class features
  ClassFeature (..),
  classAddFeatures,
  ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mempty)
#endif
import Foreign.Hoppy.Generator.Spec.Base
import Foreign.Hoppy.Generator.Spec.Class
import Foreign.Hoppy.Generator.Types

-- | Sets of functionality that can be stamped onto a class with
-- 'classAddFeatures'.
data ClassFeature =
    Assignable
    -- ^ Provides the assignment operator, @Foo& Foo::operator=(const Foo&)@.
  | Comparable
    -- ^ Provides operators @<@, @<=@, @>@, @>=@, for example @bool
    -- Foo::operator<(const Foo&)@.  This feature does not automatically include
    -- 'Equatable'.
  | Copyable
    -- ^ Provides copy construction, @Foo::Foo(const Foo&)@.
  | Equatable
    -- ^ Provides @operator==@ and @operator!=@, for example @bool
    -- Foo::operator==(const Foo&)@.
  deriving (ClassFeature -> ClassFeature -> Bool
(ClassFeature -> ClassFeature -> Bool)
-> (ClassFeature -> ClassFeature -> Bool) -> Eq ClassFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassFeature -> ClassFeature -> Bool
$c/= :: ClassFeature -> ClassFeature -> Bool
== :: ClassFeature -> ClassFeature -> Bool
$c== :: ClassFeature -> ClassFeature -> Bool
Eq, Int -> ClassFeature -> ShowS
[ClassFeature] -> ShowS
ClassFeature -> String
(Int -> ClassFeature -> ShowS)
-> (ClassFeature -> String)
-> ([ClassFeature] -> ShowS)
-> Show ClassFeature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassFeature] -> ShowS
$cshowList :: [ClassFeature] -> ShowS
show :: ClassFeature -> String
$cshow :: ClassFeature -> String
showsPrec :: Int -> ClassFeature -> ShowS
$cshowsPrec :: Int -> ClassFeature -> ShowS
Show)

featureContents :: ClassFeature -> Class -> ([ClassEntity], Reqs)
featureContents :: ClassFeature -> Class -> ([ClassEntity], Reqs)
featureContents ClassFeature
feature Class
cls = case ClassFeature
feature of
  ClassFeature
Assignable -> Class -> ([ClassEntity], Reqs)
assignableContents Class
cls
  ClassFeature
Comparable -> Class -> ([ClassEntity], Reqs)
comparableContents Class
cls
  ClassFeature
Copyable -> Class -> ([ClassEntity], Reqs)
copyableContents Class
cls
  ClassFeature
Equatable -> Class -> ([ClassEntity], Reqs)
equatableContents Class
cls

assignableContents :: Class -> ([ClassEntity], Reqs)
assignableContents :: Class -> ([ClassEntity], Reqs)
assignableContents Class
cls =
  ([ Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod Operator
OpAssign [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls
   ],
   Reqs
forall a. Monoid a => a
mempty)

comparableContents :: Class -> ([ClassEntity], Reqs)
comparableContents :: Class -> ([ClassEntity], Reqs)
comparableContents Class
cls =
  ([ Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpLt [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls] Type
boolT
   , Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpLe [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls] Type
boolT
   , Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpGt [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls] Type
boolT
   , Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpGe [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls] Type
boolT
   ],
   Reqs
forall a. Monoid a => a
mempty)

copyableContents :: Class -> ([ClassEntity], Reqs)
copyableContents :: Class -> ([ClassEntity], Reqs)
copyableContents Class
cls =
  ([ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newCopy" [Class -> Type
objT Class
cls]
   ],
   Reqs
forall a. Monoid a => a
mempty)

equatableContents :: Class -> ([ClassEntity], Reqs)
equatableContents :: Class -> ([ClassEntity], Reqs)
equatableContents Class
cls =
  ([ Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpEq [Class -> Type
objT Class
cls] Type
boolT
   , Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpNe [Class -> Type
objT Class
cls] Type
boolT
   ],
   Reqs
forall a. Monoid a => a
mempty)

-- | Adds the contents of a feature to a class.  Does not check for overlap with
-- existing class contents.
classAddFeatures :: [ClassFeature] -> Class -> Class
classAddFeatures :: [ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature]
features Class
cls =
  (ClassFeature -> Class -> Class)
-> Class -> [ClassFeature] -> Class
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ClassFeature
feature Class
cls' ->
          let ([ClassEntity]
entities, Reqs
reqs) = ClassFeature -> Class -> ([ClassEntity], Reqs)
featureContents ClassFeature
feature Class
cls'
          in Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
             [ClassEntity] -> Class -> Class
classAddEntities [ClassEntity]
entities Class
cls')
        Class
cls
        [ClassFeature]
features