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

-- | Support for STL-style iterators.  The functions in this module modify a
-- class to add functionality that is provided by different types of STL
-- iterators.  In the method pseudotypes documented here, the parameter types
-- are 'Type's, and all methods are nonpure.
module Foreign.Hoppy.Generator.Std.Iterator (
  IteratorMutability (..),
  makeTrivialIterator,
  makeForwardIterator,
  makeBidirectionalIterator,
  makeRandomIterator,
  ) where

import Data.Maybe (catMaybes, isJust)
import Foreign.Hoppy.Generator.Spec (
  ClassFeature (Assignable, Copyable, Equatable),
  Operator (
    OpAdd,
    OpAddAssign,
    OpArray,
    OpDecPre,
    OpDeref,
    OpIncPre,
    OpSubtract,
    OpSubtractAssign),
  Purity (Nonpure),
  Type,
  addReqIncludes,
  classAddFeatures,
  ident2,
  np,
  )
import Foreign.Hoppy.Generator.Types
import Foreign.Hoppy.Generator.Spec.Class (
  Class,
  MethodApplicability (MNormal),
  classAddEntities,
  makeFnMethod,
  mkConstMethod',
  mkCtor,
  mkMethod',
  )
import Foreign.Hoppy.Generator.Std.Internal (includeHelper)

-- | Whether an iterator may be used to modify the underlying collection.
data IteratorMutability = Constant | Mutable
  deriving (IteratorMutability -> IteratorMutability -> Bool
(IteratorMutability -> IteratorMutability -> Bool)
-> (IteratorMutability -> IteratorMutability -> Bool)
-> Eq IteratorMutability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IteratorMutability -> IteratorMutability -> Bool
$c/= :: IteratorMutability -> IteratorMutability -> Bool
== :: IteratorMutability -> IteratorMutability -> Bool
$c== :: IteratorMutability -> IteratorMutability -> Bool
Eq, Eq IteratorMutability
Eq IteratorMutability
-> (IteratorMutability -> IteratorMutability -> Ordering)
-> (IteratorMutability -> IteratorMutability -> Bool)
-> (IteratorMutability -> IteratorMutability -> Bool)
-> (IteratorMutability -> IteratorMutability -> Bool)
-> (IteratorMutability -> IteratorMutability -> Bool)
-> (IteratorMutability -> IteratorMutability -> IteratorMutability)
-> (IteratorMutability -> IteratorMutability -> IteratorMutability)
-> Ord IteratorMutability
IteratorMutability -> IteratorMutability -> Bool
IteratorMutability -> IteratorMutability -> Ordering
IteratorMutability -> IteratorMutability -> IteratorMutability
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IteratorMutability -> IteratorMutability -> IteratorMutability
$cmin :: IteratorMutability -> IteratorMutability -> IteratorMutability
max :: IteratorMutability -> IteratorMutability -> IteratorMutability
$cmax :: IteratorMutability -> IteratorMutability -> IteratorMutability
>= :: IteratorMutability -> IteratorMutability -> Bool
$c>= :: IteratorMutability -> IteratorMutability -> Bool
> :: IteratorMutability -> IteratorMutability -> Bool
$c> :: IteratorMutability -> IteratorMutability -> Bool
<= :: IteratorMutability -> IteratorMutability -> Bool
$c<= :: IteratorMutability -> IteratorMutability -> Bool
< :: IteratorMutability -> IteratorMutability -> Bool
$c< :: IteratorMutability -> IteratorMutability -> Bool
compare :: IteratorMutability -> IteratorMutability -> Ordering
$ccompare :: IteratorMutability -> IteratorMutability -> Ordering
$cp1Ord :: Eq IteratorMutability
Ord, Int -> IteratorMutability -> ShowS
[IteratorMutability] -> ShowS
IteratorMutability -> String
(Int -> IteratorMutability -> ShowS)
-> (IteratorMutability -> String)
-> ([IteratorMutability] -> ShowS)
-> Show IteratorMutability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IteratorMutability] -> ShowS
$cshowList :: [IteratorMutability] -> ShowS
show :: IteratorMutability -> String
$cshow :: IteratorMutability -> String
showsPrec :: Int -> IteratorMutability -> ShowS
$cshowsPrec :: Int -> IteratorMutability -> ShowS
Show)

-- | @makeTrivialIteartor mutable valueTypeMaybe cls@ turns a class into a
-- trivial iterator, adding:
--
-- * A default constructor named @new@.
--
-- * The class features 'Assignable', 'Copyable', and 'Equatable'.
--
-- * __operator*:__ @getConst :: this -> 'refT' ('constT' valueType)@; if
-- @valueTypeMaybe@ is present.
--
-- * __operator*:__ @get :: this -> 'refT' valueType@; if @valueTypeMaybe@ is
-- present and @mutable@ is 'Mutable'.
--
-- * __*iter = x:__ @put :: this -> valueType -> 'voidT'@; if @valueTypeMaybe@
-- is present and @mutable@ is 'Mutable'.
makeTrivialIterator :: IteratorMutability -> Maybe Type -> Class -> Class
makeTrivialIterator :: IteratorMutability -> Maybe Type -> Class -> Class
makeTrivialIterator IteratorMutability
mutable Maybe Type
valueTypeMaybe Class
cls =
  (if Maybe Type -> Bool
forall a. Maybe a -> Bool
isJust Maybe Type
valueTypeMaybe Bool -> Bool -> Bool
&& IteratorMutability
mutable IteratorMutability -> IteratorMutability -> Bool
forall a. Eq a => a -> a -> Bool
== IteratorMutability
Mutable
   then [Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [String -> Include
includeHelper String
"iterator.hpp"]
   else Class -> Class
forall a. a -> a
id) (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  [ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature
Assignable, ClassFeature
Copyable, ClassFeature
Equatable] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  [ClassEntity] -> Class -> Class
classAddEntities [ClassEntity]
ents Class
cls
  where ents :: [ClassEntity]
ents =
          [Maybe ClassEntity] -> [ClassEntity]
forall a. [Maybe a] -> [a]
catMaybes
          [ ClassEntity -> Maybe ClassEntity
forall a. a -> Maybe a
Just (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"new" [Parameter]
np
          , do Type
valueType <- Maybe Type
valueTypeMaybe
               IteratorMutability
Mutable <- IteratorMutability -> Maybe IteratorMutability
forall a. a -> Maybe a
Just IteratorMutability
mutable
               ClassEntity -> Maybe ClassEntity
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpDeref String
"get" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
valueType
          , do Type
valueType <- Maybe Type
valueTypeMaybe
               ClassEntity -> Maybe ClassEntity
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' Operator
OpDeref String
"getConst" [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
valueType
          , do Type
valueType <- Maybe Type
valueTypeMaybe
               IteratorMutability
Mutable <- IteratorMutability -> Maybe IteratorMutability
forall a. a -> Maybe a
Just IteratorMutability
mutable
               ClassEntity -> Maybe ClassEntity
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe 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
"iterator" String
"put") String
"put"
                 MethodApplicability
MNormal Purity
Nonpure [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
cls, Type
valueType] Type
voidT
          ]

-- | Turns a class into a forward iterator, including everything from
-- 'makeTrivialIterator' plus the pre-increment operator:
--
-- * __operator++:__ @next :: this -> 'refT' ('objT' cls)@.
makeForwardIterator :: IteratorMutability -> Maybe Type -> Class -> Class
makeForwardIterator :: IteratorMutability -> Maybe Type -> Class -> Class
makeForwardIterator IteratorMutability
mutable Maybe Type
valueTypeMaybe Class
cls =
  [ClassEntity] -> Class -> Class
classAddEntities [ClassEntity]
ents (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  IteratorMutability -> Maybe Type -> Class -> Class
makeTrivialIterator IteratorMutability
mutable Maybe Type
valueTypeMaybe Class
cls
  where ents :: [ClassEntity]
ents =
          [ Operator -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpIncPre String
"next" [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
$ Class -> Type
objT Class
cls
          ]

-- | Turns a class into a bidirectional iterator, including everything from
-- 'makeForwardIterator' plus the pre-decrement operator:
--
-- * __operator--:__ @prev :: this -> 'refT' ('objT' cls)@.
makeBidirectionalIterator :: IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator :: IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator IteratorMutability
mutability Maybe Type
valueTypeMaybe Class
cls =
  [ClassEntity] -> Class -> Class
classAddEntities [ClassEntity]
ents (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  IteratorMutability -> Maybe Type -> Class -> Class
makeForwardIterator IteratorMutability
mutability Maybe Type
valueTypeMaybe Class
cls
  where ents :: [ClassEntity]
ents =
          [ Operator -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpDecPre String
"prev" [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
$ Class -> Type
objT Class
cls
          ]

-- | @makeRandomIterator mutable valueTypeMaybe distanceType cls@ turns a class
-- into a random iterator, including everything from 'makeBidirectionalIterator'
-- plus some methods:
--
-- * __operator+=:__ @add :: this -> distanceType -> 'refT' ('objT' cls)@.
--
-- * __operator+:__ @plus :: this -> distanceType -> 'toGcT' cls@.
--
-- * __operator-=:__ @subtract :: distanceType -> 'refT' ('objT' cls)@.
--
-- * __operator-:__ @minus :: distanceType -> 'toGcT' cls@.
--
-- * __operator-:__ @difference :: this -> this -> distanceType@.
--
-- * __operator[]:__ @atConst :: distanceType -> 'refT' ('constT' valueType)@;
-- if @valueTypeMaybe@ is present.
--
-- * __operator[]:__ @at :: distanceType -> 'refT' valueType@; if
-- @valueTypeMaybe@ is present and @mutable@ is 'Mutable'.
makeRandomIterator :: IteratorMutability -> Maybe Type -> Type -> Class -> Class
makeRandomIterator :: IteratorMutability -> Maybe Type -> Type -> Class -> Class
makeRandomIterator IteratorMutability
mutable Maybe Type
valueTypeMaybe Type
distanceType Class
cls =
  [ClassEntity] -> Class -> Class
classAddEntities [ClassEntity]
ents (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  IteratorMutability -> Maybe Type -> Class -> Class
makeBidirectionalIterator IteratorMutability
mutable Maybe Type
valueTypeMaybe Class
cls
  where ents :: [ClassEntity]
ents =
          [Maybe ClassEntity] -> [ClassEntity]
forall a. [Maybe a] -> [a]
catMaybes
          [ ClassEntity -> Maybe ClassEntity
forall a. a -> Maybe a
Just (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpAdd String
"plus" [Type
distanceType] (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
cls
          , ClassEntity -> Maybe ClassEntity
forall a. a -> Maybe a
Just (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpAddAssign String
"add" [Type
distanceType] (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
          , ClassEntity -> Maybe ClassEntity
forall a. a -> Maybe a
Just (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpSubtract String
"minus" [Type
distanceType] (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
cls
          , ClassEntity -> Maybe ClassEntity
forall a. a -> Maybe a
Just (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpSubtract String
"difference" [Class -> Type
objT Class
cls] Type
distanceType
          , ClassEntity -> Maybe ClassEntity
forall a. a -> Maybe a
Just (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpSubtractAssign String
"subtract" [Type
distanceType] (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
          , do Type
valueType <- Maybe Type
valueTypeMaybe
               IteratorMutability
Mutable <- IteratorMutability -> Maybe IteratorMutability
forall a. a -> Maybe a
Just IteratorMutability
mutable
               ClassEntity -> Maybe ClassEntity
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpArray String
"at" [Type
distanceType] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
valueType
          , do Type
valueType <- Maybe Type
valueTypeMaybe
               ClassEntity -> Maybe ClassEntity
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassEntity -> Maybe ClassEntity)
-> ClassEntity -> Maybe ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' Operator
OpArray String
"atConst" [Type
distanceType] (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
valueType
          ]