-- This file is part of Hoppy.
--
-- Copyright 2015-2021 Bryan Gardiner <bog@khumba.net>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE CPP #-}

-- | Bindings for @std::pair@.
module Foreign.Hoppy.Generator.Std.Pair (
  Options (..),
  defaultOptions,
  Contents (..),
  instantiate,
  instantiate',
  toExports,
  ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mconcat)
#endif
import Foreign.Hoppy.Generator.Spec (
  Export (Export),
  Purity (Nonpure),
  Reqs,
  Type,
  addReqs,
  ident1T,
  ident2,
  includeStd,
  np,
  reqInclude,
  toExtName,
  )
import Foreign.Hoppy.Generator.Spec.Class (
  Class,
  MethodApplicability (MConst, MNormal),
  makeClass,
  makeFnMethod,
  mkCtor,
  mkMethod,
  )
import Foreign.Hoppy.Generator.Spec.ClassFeature (
  ClassFeature (Assignable, Copyable),
  classAddFeatures,
  )
import Foreign.Hoppy.Generator.Std.Internal (includeHelper)
import Foreign.Hoppy.Generator.Types
import Foreign.Hoppy.Generator.Version (CppVersion (Cpp2011), activeCppVersion, collect, just, test)

-- | Options for instantiating @pair@.
newtype Options = Options
  { Options -> [ClassFeature]
optPairClassFeatures :: [ClassFeature]
    -- ^ Additional features to add to the @std::pair@ class.  Pairs are always
    -- 'Assignable' and 'Copyable'.
  }

-- | The default options have no additional 'ClassFeature's.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = [ClassFeature] -> Options
Options []

-- | A set of instantiated pair classes.
newtype Contents = Contents
  { Contents -> Class
c_pair :: Class  -- ^ @std::pair\<A, B>@
  }

-- | @instantiate className a b reqs@ creates a set of bindings for an
-- instantiation of @std::pair\<a, b\>@.  In the result, the 'c_pair' class has
-- an external name of @className@.
instantiate :: String -> Type -> Type -> Reqs -> Contents
instantiate :: String -> Type -> Type -> Reqs -> Contents
instantiate String
pairName Type
a Type
b Reqs
reqs = String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' String
pairName Type
a Type
b Reqs
reqs Options
defaultOptions

-- | 'instantiate' with additional options.
instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' String
pairName Type
a Type
b Reqs
userReqs Options
opts =
  let reqs :: Reqs
reqs = [Reqs] -> Reqs
forall a. Monoid a => [a] -> a
mconcat
             [ Reqs
userReqs
             , Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeHelper String
"utility.hpp"
             , Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"utility"
             ]

      pair :: Class
pair =
        Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        [ClassFeature] -> Class -> Class
classAddFeatures (ClassFeature
Assignable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: ClassFeature
Copyable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: Options -> [ClassFeature]
optPairClassFeatures Options
opts) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass (String -> String -> [Type] -> Identifier
ident1T String
"std" String
"pair" [Type
a, Type
b]) (ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
pairName) [] ([ClassEntity] -> Class) -> [ClassEntity] -> Class
forall a b. (a -> b) -> a -> b
$
        [Filtered ClassEntity] -> [ClassEntity]
forall a. [Filtered a] -> [a]
collect
        [ ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"new" [Parameter]
np
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newWith" [Type
a, Type
b]
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod (String -> String -> String -> Identifier
ident2 String
"hoppy" String
"utility" String
"pairFirst") String
"first" MethodApplicability
MNormal Purity
Nonpure
          [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
pair] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
a
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod (String -> String -> String -> Identifier
ident2 String
"hoppy" String
"utility" String
"pairFirst") String
"firstConst" MethodApplicability
MConst Purity
Nonpure
          [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
pair] (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
$ Type -> Type
constT Type
a
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod (String -> String -> String -> Identifier
ident2 String
"hoppy" String
"utility" String
"pairSecond") String
"second" MethodApplicability
MNormal Purity
Nonpure
          [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
pair] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
b
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Identifier
-> String
-> MethodApplicability
-> Purity
-> [Type]
-> Type
-> ClassEntity
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name
-> String
-> MethodApplicability
-> Purity
-> [p]
-> Type
-> ClassEntity
makeFnMethod (String -> String -> String -> Identifier
ident2 String
"hoppy" String
"utility" String
"pairSecond") String
"secondConst" MethodApplicability
MConst Purity
Nonpure
          [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
pair] (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
$ Type -> Type
constT Type
b
        , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (CppVersion
activeCppVersion CppVersion -> CppVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CppVersion
Cpp2011) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"swap" [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
pair] Type
voidT
        ]

  in Contents :: Class -> Contents
Contents
     { c_pair :: Class
c_pair = Class
pair
     }

-- | Converts an instantiation into a list of exports to be included in a
-- module.
toExports :: Contents -> [Export]
toExports :: Contents -> [Export]
toExports Contents
m = ((Contents -> Class) -> Export) -> [Contents -> Class] -> [Export]
forall a b. (a -> b) -> [a] -> [b]
map (Class -> Export
forall a. Exportable a => a -> Export
Export (Class -> Export)
-> ((Contents -> Class) -> Class) -> (Contents -> Class) -> Export
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Contents -> Class) -> Contents -> Class
forall a b. (a -> b) -> a -> b
$ Contents
m)) [Contents -> Class
c_pair]