--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Foldable.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Convenience classes for types that can be built from foldable collections.
--
--------------------------------------------------------------------------------
module HGeometry.Foldable.Util
  ( HasFromFoldable(..)
  , HasFromFoldable1(..)
  ) where

import qualified Data.Foldable as F
import           Data.Foldable1
import           Data.Functor.Const
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Sequence as Seq
import qualified Data.Vector as Vector
import qualified Data.Vector.NonEmpty as NonEmptyVector
import           Data.Vector.NonEmpty.Internal (NonEmptyVector(..))

--------------------------------------------------------------------------------

-- | Types that can be built from foldable collections
class HasFromFoldable f where
  -- | Build the data structure from something that is foldable.
  fromFoldable :: Foldable g => g a -> f a
  fromFoldable = [a] -> f a
forall a. [a] -> f a
forall (f :: * -> *) a. HasFromFoldable f => [a] -> f a
fromList ([a] -> f a) -> (g a -> [a]) -> g a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> [a]
forall a. g a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

  -- | Build the data structure from a list of elements
  fromList :: [a] -> f a
  {-# MINIMAL fromList #-}

-- | Types that can be built from non-empty foldable collections
class HasFromFoldable1 f where
  -- | Build the data structure from something that is foldable and
  -- has at least one element.
  fromFoldable1 :: Foldable1 g => g a -> f a
  fromFoldable1 = NonEmpty a -> f a
forall a. NonEmpty a -> f a
forall (f :: * -> *) a. HasFromFoldable1 f => NonEmpty a -> f a
fromNonEmpty (NonEmpty a -> f a) -> (g a -> NonEmpty a) -> g a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> NonEmpty a
forall a. g a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty

  -- | Build the data structure from a non-empty list of elements
  fromNonEmpty :: NonEmpty a -> f a
  {-# MINIMAL fromNonEmpty #-}


--------------------------------------------------------------------------------
-- * Instances

instance HasFromFoldable [] where
  fromList :: forall a. [a] -> [a]
fromList = [a] -> [a]
forall a. a -> a
id

instance HasFromFoldable Seq.Seq where
  fromList :: forall a. [a] -> Seq a
fromList = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList

instance Monoid c => HasFromFoldable (Const c) where
  fromList :: forall a. [a] -> Const c a
fromList [a]
_ = c -> Const c a
forall {k} a (b :: k). a -> Const a b
Const c
forall a. Monoid a => a
mempty

instance HasFromFoldable1 NonEmpty where
  fromNonEmpty :: forall a. NonEmpty a -> NonEmpty a
fromNonEmpty = NonEmpty a -> NonEmpty a
forall a. a -> a
id

instance HasFromFoldable1 Seq.Seq where
  fromNonEmpty :: forall a. NonEmpty a -> Seq a
fromNonEmpty = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> (NonEmpty a -> [a]) -> NonEmpty a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

instance HasFromFoldable Vector.Vector  where
  fromList :: forall a. [a] -> Vector a
fromList = [a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList


instance HasFromFoldable1 NonEmptyVector  where
  fromNonEmpty :: forall a. NonEmpty a -> NonEmptyVector a
fromNonEmpty = NonEmpty a -> NonEmptyVector a
forall a. NonEmpty a -> NonEmptyVector a
NonEmptyVector.fromNonEmpty