module Data.NonEmpty.Class where

import qualified Data.List as List
import Control.Monad (liftM2, )
import Data.Tuple.HT (forcePair, mapSnd, )
import qualified Data.List.HT as ListHT

import qualified Test.QuickCheck as QC

import Prelude hiding (zipWith, )


class Empty f where
   empty :: f a

instance Empty [] where
   empty = []

instance Empty Maybe where
   empty = Nothing


class Cons f where
   cons :: a -> f a -> f a

instance Cons [] where
   cons = (:)


class View f where
   viewL :: f a -> Maybe (a, f a)

instance View [] where
   viewL = ListHT.viewL

instance View Maybe where
   viewL = fmap (\a -> (a, Nothing))


class Singleton f where
   singleton :: a -> f a

instance Singleton [] where
   singleton x = [x]

instance Singleton Maybe where
   singleton x = Just x


class Append f where
   append :: f a -> f a -> f a

instance Append [] where
   append = (++)

infixr 5 `cons`, `append`


class Zip f where
   zipWith :: (a -> b -> c) -> f a -> f b -> f c

instance Zip [] where
   zipWith = List.zipWith

instance Zip Maybe where
   zipWith = liftM2

zip :: (Zip f) => f a -> f b -> f (a,b)
zip = zipWith (,)


class Sort f where
   sortBy :: (a -> a -> Ordering) -> f a -> f a
   insertBy :: (a -> a -> Ordering) -> a -> f a -> (a, f a)

instance Sort [] where
   sortBy = List.sortBy
   insertBy f y xt =
      forcePair $
      case xt of
         [] -> (y, xt)
         x:xs ->
            case f y x of
               GT -> (x, List.insertBy f y xs)
               _ -> (y, xt)

instance Sort Maybe where
   sortBy _f = id
   insertBy f y mx =
      forcePair $
      case mx of
         Nothing -> (y, Nothing)
         Just x ->
            mapSnd Just $
            case f y x of
               GT -> (x, y)
               _ -> (y, x)

sort :: (Ord a, Sort f) => f a -> f a
sort = sortBy compare

{- |
Insert an element into an ordered list while preserving the order.
The first element of the resulting list is returned individually.
We need this for construction of a non-empty list.
-}
insert :: (Ord a, Sort f) => a -> f a -> (a, f a)
insert = insertBy compare


class Arbitrary f where
   arbitrary :: QC.Arbitrary a => QC.Gen (f a)
   shrink :: QC.Arbitrary a => f a -> [f a]

instance Arbitrary [] where
   arbitrary = QC.arbitrary
   shrink = QC.shrink