{-# LANGUAGE CPP #-}
module Foreign.Hoppy.Generator.Spec.ClassFeature (
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
data ClassFeature =
Assignable
| Comparable
| Copyable
| Equatable
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)
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