{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTSyntax #-}

-- |
-- Module      :  Diagrams.CubicSpline.NonSingleton
-- Copyright   :  (c) 2026 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A simple type representing lists with at least 2 elements, needed
-- as input for the cubic spline solver.
module Diagrams.CubicSpline.NonSingleton (
  -- * Non-singleton lists
  NonSingleton (..),
  toNonEmpty,
  tail,
  zipWith,
  dupFirst,
  dupLast,
) where

import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Prelude hiding (tail, zipWith)

-- | Lists with at least 2 elements.
data NonSingleton a where
  (:||) :: a -> NonEmpty a -> NonSingleton a
  deriving ((forall a b. (a -> b) -> NonSingleton a -> NonSingleton b)
-> (forall a b. a -> NonSingleton b -> NonSingleton a)
-> Functor NonSingleton
forall a b. a -> NonSingleton b -> NonSingleton a
forall a b. (a -> b) -> NonSingleton a -> NonSingleton b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NonSingleton a -> NonSingleton b
fmap :: forall a b. (a -> b) -> NonSingleton a -> NonSingleton b
$c<$ :: forall a b. a -> NonSingleton b -> NonSingleton a
<$ :: forall a b. a -> NonSingleton b -> NonSingleton a
Functor)

infixr 5 :||

toNonEmpty :: NonSingleton a -> NonEmpty a
toNonEmpty :: forall a. NonSingleton a -> NonEmpty a
toNonEmpty (a
x :|| NonEmpty a
xs) = a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons a
x NonEmpty a
xs

dupFirst :: NonSingleton a -> NonSingleton a
dupFirst :: forall a. NonSingleton a -> NonSingleton a
dupFirst (a
x :|| NonEmpty a
xs) = a
x a -> NonEmpty a -> NonSingleton a
forall a. a -> NonEmpty a -> NonSingleton a
:|| a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons a
x NonEmpty a
xs

dupLast :: NonEmpty a -> NonSingleton a
dupLast :: forall a. NonEmpty a -> NonSingleton a
dupLast (a
x :| []) = a
x a -> NonEmpty a -> NonSingleton a
forall a. a -> NonEmpty a -> NonSingleton a
:|| (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [])
dupLast (a
x :| (a
y : [a]
ys)) = a
x a -> NonEmpty a -> NonSingleton a
forall a. a -> NonEmpty a -> NonSingleton a
:|| (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| ([a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [NonEmpty a -> a
forall a. NonEmpty a -> a
NE.last (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ys)]))

zipWith :: (a -> b -> c) -> NonSingleton a -> NonSingleton b -> NonSingleton c
zipWith :: forall a b c.
(a -> b -> c) -> NonSingleton a -> NonSingleton b -> NonSingleton c
zipWith a -> b -> c
f (a
x :|| NonEmpty a
xs) (b
y :|| NonEmpty b
ys) = a -> b -> c
f a
x b
y c -> NonEmpty c -> NonSingleton c
forall a. a -> NonEmpty a -> NonSingleton a
:|| (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith a -> b -> c
f NonEmpty a
xs NonEmpty b
ys

tail :: NonSingleton a -> NonEmpty a
tail :: forall a. NonSingleton a -> NonEmpty a
tail (a
_ :|| NonEmpty a
xs) = NonEmpty a
xs