{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.List
    ( ZipList (..)
    , Nondet ()
    , nondet
    , getNondet
    , foldr
    , foldl
    , concat
    , concatMap
    , repeat
    ) where

import Control.Functor.Compose
import Control.Monad
import Data.Fixpoint
import Data.Function
import Data.Group
import Data.Wrapper

instance Magma [a] where
    op a = flip cata a . flip casePreList (:)

instance Semigroup [a]

instance Unital [a] where
    unit = []

instance Monoid [a]

instance Functor Hask [] where
    ($>) = cata . casePreList [] . result (:)

instance Pointed Hask [] where
    point = (:[])

newtype Nondet' a = Nondet' { getNondet' :: [a] }

deriving instance Functor Hask Nondet'
deriving instance Pointed Hask Nondet'

instance Wrapper (Nondet' a) where
    type Inner (Nondet' a) = [a]
    wrap = Nondet'
    unwrap = getNondet'

instance Applicative Hask Nondet' where
    Nondet' fs <$> Nondet' xs = Nondet' $ concatMap (flip map xs) fs

instance Monad Hask Nondet' where
    extend = inWrapper . concatMap . result getNondet'

newtype Nondet a = Nondet { getNondet'' :: Nondet' :$ a }
    deriving (Magma, Quasigroup, Unital, Loop, Semigroup, Monoid, Group)

deriving instance Functor Hask Nondet
deriving instance Pointed Hask Nondet
deriving instance Applicative Hask Nondet
deriving instance Monad Hask Nondet

instance Wrapper (Nondet a) where
    type Inner (Nondet a) = [a]
    wrap = Nondet . wrap . wrap
    unwrap = unwrap . unwrap . getNondet''

nondet :: [a] -> Nondet a
nondet = wrap

getNondet :: Nondet a -> [a]
getNondet = unwrap

newtype ZipList a = ZipList { getZipList :: [a] }

instance Wrapper (ZipList a) where
    type Inner (ZipList a) = [a]
    wrap = ZipList
    unwrap = getZipList

instance Functor Hask ZipList where
    ($>) = inWrapper . map

instance Pointed Hask ZipList where
    point = ZipList . repeat

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr = result2 cata $ flip casePreList

foldl :: (a -> b -> a) -> a -> [b] -> a
foldl f = flip $ foldr ((<<<) . flip f) id

concat :: Unital a => [a] -> a
concat = foldr op unit

concatMap :: Unital b => (a -> b) -> [a] -> b
concatMap = result concat . map

repeat :: a -> [a]
repeat = ana $ join Cons