module Data.NonEmpty.Class where

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

import qualified Test.QuickCheck as QC

import qualified Prelude as P
import Prelude hiding (Show, showsPrec, zipWith, reverse, )


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`


{- |
It must hold:

> fmap f xs
>    = zipWith (\x _ -> f x) xs xs
>    = zipWith (\_ x -> f x) xs xs
-}
class Functor f => 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 Repeat f where
   repeat :: a -> f a

instance Repeat [] where
   repeat = List.repeat


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

instance Sort [] where
   sortBy = List.sortBy

instance Sort Maybe where
   sortBy _f = id

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


class Reverse f where
   reverse :: f a -> f a

instance Reverse [] where reverse = P.reverse
instance Reverse Maybe where reverse = id


class Show f where
   showsPrec :: P.Show a => Int -> f a -> ShowS

instance Show [] where
   showsPrec p xs =
      if null xs
        then showString "[]"
        else showParen (p>5) $
             foldr (.) (showString "[]") $
             map (\x -> P.showsPrec 6 x . showString ":") xs


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