phi

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Array
-- Copyright   :  (c) 2020-2021 EMQ Technologies Co., Ltd.
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  Feng Lee, feng@emqx.io
--                Yang M, yangm@emqx.io
--                Zhang sw zhangsw@emqx.io
-- Stability   :  experimental
-- Portability :  portable
--
-- The Array datatype.
--
-----------------------------------------------------------------------------
module Data.Array where

import Data.Eq (class Eq, (==))
import Data.Ord (class Ord, compare)
import Data.Show (class Show, show)
import Data.Read (class Read, read)
import Data.Functor (class Functor, (<$>))
import Data.Foldable (class Foldable, foldr)
import Data.Traversable (class Traversable, sequence)

import Data.Bool (Bool)
import Data.Monoid (mempty)
import Data.Semigroup ((<>))
import Data.OrdDict (OrdDict)
import Control.Monad (liftA1, class Monad, class Applicative, apply, bind)

import Foreign (ffi1, ffi2, ffi3)

import Test.QuickCheck (arbitrary, class Arbitrary)

foreign import data Array :: Type -> Type

instance Eq t => Eq (Array t) where
  eq a b = toList a == toList b

instance Ord t => Ord (Array t) where
  compare a b = compare (toList a) (toList b)

instance Show t => Show (Array t) where
  show a = show (toList a)

instance Read t => Read (Array t) where
  read a = fromList (read a)

instance Functor Array where
  map = ffi2 :array :map

instance Foldable Array where
  foldl = foldlImpl
  foldr = foldrImpl
  foldMap f = foldr (\x acc -> f x <> acc) mempty

foldlImpl :: forall a b. (b -> a -> b) -> b -> Array a -> b
foldlImpl f b0 a = arrayFoldl (\_ -> f) b0 a

foldrImpl :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldrImpl f b0 a = arrayFoldr (\_ -> f) b0 a

foreign import arrayFoldl :: forall a b. (Integer -> b -> a -> b) -> b -> Array a -> b

foreign import arrayFoldr :: forall a b. (Integer -> a -> b -> b) -> b -> Array a -> b

instance Traversable Array where
  traverse f ta = sequence (f <$> ta)
  sequence x = liftA1 fromList (sequence (toList x))

instance Applicative Array where
  pure x = fromList [x]
  apply fs xs = fromList (apply (toList fs) (toList xs))

instance Monad Array where
  bind xs f = fromList (bind (toList xs) (\x -> toList (f x)))

instance Arbitrary v => Arbitrary (Array v) where
  arbitrary = fromList <$> arbitrary

{- TODO: functions
is_array/1             Why a strong type system language need this?
-}

-- TODO: remove default 'undefined'
fromList :: forall a. [a] -> Array a
fromList = ffi1 :array :from_list

fromListWith :: forall a. [a] -> a -> Array a
fromListWith = ffi2 :array :from_list

fromOrdDict :: forall a. OrdDict Integer a -> Array a
fromOrdDict = ffi1 :array :from_orddict

fromOrdDictWith :: forall a. OrdDict Integer a -> a -> Array a
fromOrdDictWith = ffi2 :array :from_orddict

toList :: forall a. Array a -> [a]
toList = ffi1 :array :to_list

sparseToList :: forall a. Array a -> [a]
sparseToList = ffi1 :array :sparse_to_list

toOrdDict :: forall a. Array a -> OrdDict Integer a
toOrdDict = ffi1 :array :to_orddict

sparseToOrdDict :: forall a. Array a -> OrdDict Integer a
sparseToOrdDict = ffi1 :array :sparse_to_orddict

data ArrayOption a = Size Integer | Fix Bool | Default a

foreign import new :: forall a. [ArrayOption a] -> Array a

default :: forall a. Array a -> a
default = ffi1 :array :default

fix :: forall a. Array a -> Array a
fix = ffi1 :array :fix

relax :: forall a. Array a -> Array a
relax = ffi1 :array :relax

isFix :: forall a. Array a -> Bool
isFix = ffi1 :array :is_fix

-- TODO: Ix typeclass
get :: forall a. Integer -> Array a -> a
get = ffi2 :array :get

-- TODO: flip args
infix 9 get as !

set :: forall a. Integer -> a -> Array a -> Array a
set = ffi3 :array :set

size :: forall a. Array a -> Integer
size = ffi1 :array :size

sparseSize :: forall a. Array a -> Integer
sparseSize = ffi1 :array :sparse_size

resize :: forall a. Integer -> Array a -> Array a
resize = ffi2 :array :resize

reset :: forall a. Integer -> Array a -> Array a
reset = ffi2 :array :reset

foreign import sparseFoldl :: forall a b. (Integer -> b -> a -> b) -> b -> Array a -> b

foreign import sparseFoldr :: forall a b. (Integer -> a -> b -> b) -> b -> Array a -> b

foreign import sparseMap :: forall a b. (Integer -> a -> b) -> Array a -> Array b