-- 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::list@.
module Foreign.Hoppy.Generator.Std.List (
  Options (..),
  defaultOptions,
  Contents (..),
  instantiate,
  instantiate',
  toExports,
  ) where

import Control.Monad (forM_, when)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mconcat)
#endif
import Foreign.Hoppy.Generator.Language.Haskell (
  HsTypeSide (HsHsSide),
  addImports,
  cppTypeToHsTypeAndUse,
  indent,
  ln,
  prettyPrint,
  sayLn,
  saysLn,
  )
import Foreign.Hoppy.Generator.Spec (
  Constness (Const, Nonconst),
  Export (Export),
  Operator (OpEq),
  Purity (Nonpure),
  Reqs,
  Type,
  addAddendumHaskell,
  addReqs,
  hsImport1,
  hsImportForPrelude,
  hsImportForRuntime,
  ident1T,
  ident2,
  identT',
  includeStd,
  np,
  reqInclude,
  toExtName,
  )
import Foreign.Hoppy.Generator.Spec.Class (
  Class,
  MethodApplicability (MConst),
  makeClass,
  makeFnMethod,
  mkConstMethod,
  mkConstMethod',
  mkCtor,
  mkMethod,
  mkMethod',
  toHsDataTypeName,
  toHsClassEntityName,
  )
import Foreign.Hoppy.Generator.Spec.ClassFeature (
  ClassFeature (Assignable, Comparable, Copyable, Equatable),
  classAddFeatures,
  )
import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))
import Foreign.Hoppy.Generator.Std.Iterator
import Foreign.Hoppy.Generator.Types
import Foreign.Hoppy.Generator.Version (collect, just, test)

-- | Options for instantiating the list classes.
data Options = Options
  { Options -> [ClassFeature]
optListClassFeatures :: [ClassFeature]
    -- ^ Additional features to add to the @std::list@ class.  Lists are always
    -- 'Assignable' and 'Copyable', but you may want to add 'Equatable' and
    -- 'Comparable' if your value type supports those.
  , Options -> Maybe ValueConversion
optValueConversion :: Maybe ValueConversion
  }

-- | The default options have no additional 'ClassFeature's.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = [ClassFeature] -> Maybe ValueConversion -> Options
Options [] Maybe ValueConversion
forall a. Maybe a
Nothing

-- | A set of instantiated list classes.
data Contents = Contents
  { Contents -> Class
c_list :: Class  -- ^ @std::list\<T>@
  , Contents -> Class
c_iterator :: Class  -- ^ @std::list\<T>::iterator@
  , Contents -> Class
c_constIterator :: Class  -- ^ @std::list\<T>::const_iterator@
  }

-- | @instantiate className t tReqs@ creates a set of bindings for an
-- instantiation of @std::list@ and associated types (e.g. iterators).  In the
-- result, the 'c_list' class has an external name of @className@, and the
-- iterator classes are further suffixed with @\"Iterator\"@ and
-- @\"ConstIterator\"@ respectively.
instantiate :: String -> Type -> Reqs -> Contents
instantiate :: String -> Type -> Reqs -> Contents
instantiate String
listName Type
t Reqs
tReqs = String -> Type -> Reqs -> Options -> Contents
instantiate' String
listName Type
t Reqs
tReqs Options
defaultOptions

-- | 'instantiate' with additional options.
instantiate' :: String -> Type -> Reqs -> Options -> Contents
instantiate' :: String -> Type -> Reqs -> Options -> Contents
instantiate' String
listName Type
t Reqs
tReqs Options
opts =
  let reqs :: Reqs
reqs = [Reqs] -> Reqs
forall a. Monoid a => [a] -> a
mconcat [Reqs
tReqs, Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"list"]
      iteratorName :: String
iteratorName = String
listName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Iterator"
      constIteratorName :: String
constIteratorName = String
listName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ConstIterator"
      features :: [ClassFeature]
features = ClassFeature
Assignable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: ClassFeature
Copyable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: Options -> [ClassFeature]
optListClassFeatures Options
opts

      list :: Class
list =
        (case Options -> Maybe ValueConversion
optValueConversion Options
opts of
           Maybe ValueConversion
Nothing -> Class -> Class
forall a. a -> a
id
           Just ValueConversion
conversion -> Generator () -> Class -> Class
forall a. HasAddendum a => Generator () -> a -> a
addAddendumHaskell (Generator () -> Class -> Class) -> Generator () -> Class -> Class
forall a b. (a -> b) -> a -> b
$ ValueConversion -> Generator ()
makeAddendum ValueConversion
conversion) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        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]
features (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
"list" [Type
t]) (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
listName) [] ([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 -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"back" String
"back" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"back" String
"backConst" [Parameter]
np (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
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"begin" String
"begin" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"begin" String
"beginConst" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
constIterator
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"clear" [Parameter]
np Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"empty" [Parameter]
np Type
boolT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"end" String
"end" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"end" String
"endConst" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
constIterator
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"erase" String
"erase" [Class -> Type
objT Class
iterator] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"erase" String
"eraseRange" [Class -> Type
objT Class
iterator, Class -> Type
objT Class
iterator] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"front" String
"front" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"front" String
"frontConst" [Parameter]
np (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
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (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
"insert" [Class -> Type
objT Class
iterator, Type
t] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"max_size" String
"maxSize" [Parameter]
np Type
sizeT
        , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (ClassFeature -> [ClassFeature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ClassFeature
Comparable [ClassFeature]
features) (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
"merge" [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
list] Type
voidT
          -- TODO merge(list&, Comparator)
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"pop_back" String
"popBack" [Parameter]
np Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"pop_front" String
"popFront" [Parameter]
np Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"push_back" String
"pushBack" [Type
t] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"push_front" String
"pushFront" [Type
t] Type
voidT
        , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (ClassFeature
Equatable ClassFeature -> [ClassFeature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ClassFeature]
features) (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
"remove" [Type
t] Type
voidT
          -- TODO remove_if(UnaryPredicate)
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"resize" String
"resize" [Type
sizeT] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"resize" String
"resizeWith" [Type
sizeT, Type
t] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"reverse" [Parameter]
np Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"size" [Parameter]
np Type
sizeT
        , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (ClassFeature -> [ClassFeature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ClassFeature
Comparable [ClassFeature]
features) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"sort" [Parameter]
np Type
voidT
          -- TODO sort(Comparator)
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"splice" String
"spliceAll" [Class -> Type
objT Class
iterator, Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
list] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"splice" String
"spliceOne"
          [Class -> Type
objT Class
iterator, Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
list, Class -> Type
objT Class
iterator] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"splice" String
"spliceRange"
          [Class -> Type
objT Class
iterator, Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
list, Class -> Type
objT Class
iterator, Class -> Type
objT Class
iterator] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (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
list] Type
voidT
        , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (ClassFeature
Equatable ClassFeature -> [ClassFeature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ClassFeature]
features) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"unique" [Parameter]
np Type
voidT
          -- TODO unique(BinaryPredicate)
        ]

      iterator :: Class
iterator =
        Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator IteratorMutability
Mutable (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass ([(String, Maybe [Type])] -> Identifier
identT' [(String
"std", Maybe [Type]
forall a. Maybe a
Nothing), (String
"list", [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type
t]), (String
"iterator", Maybe [Type]
forall a. Maybe a
Nothing)])
        (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
iteratorName) [] []

      constIterator :: Class
constIterator =
        Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator IteratorMutability
Constant (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass ([(String, Maybe [Type])] -> Identifier
identT' [(String
"std", Maybe [Type]
forall a. Maybe a
Nothing), (String
"list", [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type
t]), (String
"const_iterator", Maybe [Type]
forall a. Maybe a
Nothing)])
        (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
constIteratorName)
        []
        [ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newFromConst" [Class -> Type
objT Class
iterator]
        , 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
"iterator" String
"deconst") String
"deconst" MethodApplicability
MConst Purity
Nonpure
          [Class -> Type
objT Class
constIterator, Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
list] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
iterator
        ]

      -- The addendum for the list class contains HasContents and FromContents
      -- instances.
      makeAddendum :: ValueConversion -> Generator ()
makeAddendum ValueConversion
conversion = do
        HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> String -> HsImportSet
hsImport1 String
"Prelude" String
"($)",
                              HsImportSet
hsImportForPrelude,
                                HsImportSet
hsImportForRuntime]
        Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueConversion
conversion ValueConversion -> ValueConversion -> Bool
forall a. Eq a => a -> a -> Bool
== ValueConversion
ConvertValue) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
          HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ String -> String -> HsImportSet
hsImport1 String
"Prelude" String
"(=<<)"

        [Constness] -> (Constness -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Constness
Const, Constness
Nonconst] ((Constness -> Generator ()) -> Generator ())
-> (Constness -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \Constness
cst -> do
          String
hsDataTypeName <- Constness -> Class -> Generator String
toHsDataTypeName Constness
cst Class
list
          HsType
hsValueType <-
            HsTypeSide -> Type -> Generator HsType
cppTypeToHsTypeAndUse HsTypeSide
HsHsSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$
            (case ValueConversion
conversion of
               ValueConversion
ConvertPtr -> Type -> Type
ptrT
               ValueConversion
ConvertValue -> Type -> Type
forall a. a -> a
id) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            case Constness
cst of
              Constness
Const -> Type -> Type
constT Type
t
              Constness
Nonconst -> Type
t

          -- Generate const and nonconst HasContents instances.
          Generator ()
ln
          [String] -> Generator ()
saysLn [String
"instance HoppyFHR.HasContents ", String
hsDataTypeName,
                  String
" (", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
hsValueType, String
") where"]
          Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
            String -> Generator ()
sayLn String
"toContents this' = do"
            Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
              String
listEmpty <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
list String
"empty"
              String
listBegin <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
list (String -> Generator String) -> String -> Generator String
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
                Constness
Const -> String
"beginConst"
                Constness
Nonconst -> String
"begin"
              String
listEnd <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
list (String -> Generator String) -> String -> Generator String
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
                Constness
Const -> String
"endConst"
                Constness
Nonconst -> String
"end"
              let iter :: Class
iter = case Constness
cst of
                    Constness
Const -> Class
constIterator
                    Constness
Nonconst -> Class
iterator
              String
iterEq <- Class -> Operator -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter Operator
OpEq
              String
iterGet <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter (String -> Generator String) -> String -> Generator String
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
                Constness
Const -> String
"getConst"
                Constness
Nonconst -> String
"get"
              String
iterPrev <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
iter String
"prev"

              [String] -> Generator ()
saysLn [String
"empty' <- ", String
listEmpty, String
" this'"]
              String -> Generator ()
sayLn String
"if empty' then HoppyP.return [] else do"
              Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
                [String] -> Generator ()
saysLn [String
"begin' <- ", String
listBegin, String
" this'"]
                [String] -> Generator ()
saysLn [String
"iter' <- ", String
listEnd, String
" this'"]
                String -> Generator ()
sayLn String
"go' iter' begin' []"
              String -> Generator ()
sayLn String
"where"
              Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
                String -> Generator ()
sayLn String
"go' iter' begin' acc' = do"
                Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
                  [String] -> Generator ()
saysLn [String
"stop' <- ", String
iterEq, String
" iter' begin'"]
                  String -> Generator ()
sayLn String
"if stop' then HoppyP.return acc' else do"
                  Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
                    [String] -> Generator ()
saysLn [String
"_ <- ", String
iterPrev, String
" iter'"]
                    [String] -> Generator ()
saysLn [String
"value' <- ",
                            case ValueConversion
conversion of
                              ValueConversion
ConvertPtr -> String
""
                              ValueConversion
ConvertValue -> String
"HoppyFHR.decode =<< ",
                            String
iterGet, String
" iter'"]
                    String -> Generator ()
sayLn String
"go' iter' begin' $ value':acc'"

          -- Only generate a nonconst FromContents instance.
          Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Constness
cst Constness -> Constness -> Bool
forall a. Eq a => a -> a -> Bool
== Constness
Nonconst) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
            Generator ()
ln
            [String] -> Generator ()
saysLn [String
"instance HoppyFHR.FromContents ", String
hsDataTypeName,
                    String
" (", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
hsValueType, String
") where"]
            Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
              String -> Generator ()
sayLn String
"fromContents values' = do"
              Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
                String
listNew <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
list String
"new"
                String
listPushBack <- Class -> String -> Generator String
forall name.
IsFnName String name =>
Class -> name -> Generator String
toHsClassEntityName Class
list String
"pushBack"
                [String] -> Generator ()
saysLn [String
"list' <- ", String
listNew]
                [String] -> Generator ()
saysLn [String
"HoppyP.mapM_ (", String
listPushBack, String
" list') values'"]
                String -> Generator ()
sayLn String
"HoppyP.return list'"

  in Contents :: Class -> Class -> Class -> Contents
Contents
     { c_list :: Class
c_list = Class
list
     , c_iterator :: Class
c_iterator = Class
iterator
     , c_constIterator :: Class
c_constIterator = Class
constIterator
     }

-- | 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_list, Contents -> Class
c_iterator, Contents -> Class
c_constIterator]