{-# LANGUAGE DeriveGeneric #-}
module Data.Svfactor.Vector.NonEmpty (
NonEmptyVector (NonEmptyVector)
, fromNel
, toNel
, toVector
, headNev
, tailNev
) where
import Control.Applicative (Applicative (..), (<$>))
import Control.DeepSeq (NFData)
import Control.Lens (Lens', lens)
import Data.Functor.Apply (Apply((<.>)))
import Data.Foldable (Foldable (..), toList)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Monoid (mappend)
import Data.Traversable (Traversable (..))
import Data.Semigroup (Semigroup ((<>)))
import Data.Semigroup.Foldable (Foldable1 (foldMap1))
import Data.Semigroup.Traversable (Traversable1 (traverse1))
import Data.Vector (Vector)
import qualified Data.Vector as V
import GHC.Generics (Generic)
data NonEmptyVector a =
NonEmptyVector a (Vector a)
deriving (Eq, Ord, Show, Generic)
instance NFData a => NFData (NonEmptyVector a) where
fromNel :: NonEmpty a -> NonEmptyVector a
fromNel (a :| as) = NonEmptyVector a (V.fromList as)
toNel :: NonEmptyVector a -> NonEmpty a
toNel (NonEmptyVector a as) = a :| V.toList as
toVector :: NonEmptyVector a -> Vector a
toVector (NonEmptyVector a as) = V.cons a as
instance Functor NonEmptyVector where
fmap f (NonEmptyVector a as) = NonEmptyVector (f a) (fmap f as)
instance Apply NonEmptyVector where
(<.>) = (<*>)
instance Applicative NonEmptyVector where
pure a = NonEmptyVector a V.empty
ff <*> fa = fromNel (toNel ff <*> toNel fa)
instance Foldable NonEmptyVector where
foldMap f (NonEmptyVector a as) = f a `mappend` foldMap f as
instance Foldable1 NonEmptyVector where
foldMap1 f (NonEmptyVector a as) = foldMap1 f (a :| toList as)
instance Traversable NonEmptyVector where
traverse f (NonEmptyVector a as) = NonEmptyVector <$> f a <*> traverse f as
instance Traversable1 NonEmptyVector where
traverse1 f = fmap fromNel . traverse1 f . toNel
instance Semigroup (NonEmptyVector a) where
NonEmptyVector a as <> NonEmptyVector b bs =
NonEmptyVector a (V.concat [as, V.singleton b, bs])
headNev :: Lens' (NonEmptyVector a) a
headNev = lens (\(NonEmptyVector h _) -> h) (\(NonEmptyVector _ t) h -> NonEmptyVector h t)
tailNev :: Lens' (NonEmptyVector a) (Vector a)
tailNev = lens (\(NonEmptyVector _ t) -> t) (\(NonEmptyVector h _) t -> NonEmptyVector h t)