{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

-- | Another way to desugar overloaded list literals. See 'Nil' and 'Cons'.
--
-- An explicit list expression, e.g. @[1, True]@ is desugared to
--
-- @
-- cons 1 (cons True nil)
-- @
--
-- Enabled with:
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Lists #-}
-- @
--
module Overloaded.Lists (
    Nil (..),
    Cons (..),
    fromList,
  ) where

import Data.Coerce        (coerce)
import Data.List.NonEmpty (NonEmpty (..))
import Data.SOP.NP        (NP (..), POP (..))

import qualified Data.Bin             as B
import qualified Data.IntMap          as IM
import qualified Data.IntSet          as IS
import qualified Data.Map             as M
import qualified Data.RAList          as RAL
import qualified Data.RAList.NonEmpty as NERAL
import qualified Data.RAVec           as RAV
import qualified Data.RAVec.NonEmpty  as NERAV
import qualified Data.Sequence        as Seq
import qualified Data.Set             as S
import qualified Data.Type.Bin        as B
import qualified Data.Type.Nat        as N
import qualified Data.Vec.Lazy        as Vec

-------------------------------------------------------------------------------
-- Classes
-------------------------------------------------------------------------------

-- | Class for nil, @[]@
--
-- See test-suite for ways to define instances for 'Data.Map.Map'.
-- There are at-least two-ways.
--
class Nil a where
    nil :: a

-- | Class for Cons ':'.
class Cons x ys zs | zs -> x ys where
    cons :: x -> ys -> zs

infixr 5 `cons`

-- | @since 0.1.3
fromList :: (Nil xs, Cons x xs xs) => [x] -> xs
fromList :: [x] -> xs
fromList = (x -> xs -> xs) -> xs -> [x] -> xs
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x -> xs -> xs
forall x ys zs. Cons x ys zs => x -> ys -> zs
cons xs
forall a. Nil a => a
nil

-------------------------------------------------------------------------------
-- base
-------------------------------------------------------------------------------

instance Nil [a] where
    nil :: [a]
nil = []

instance (a ~ b, b ~ c) =>  Cons a [b] [c] where
    cons :: a -> [b] -> [c]
cons = (:)

instance (a ~ b, b ~ c) =>  Cons a [b] (NonEmpty c) where
    cons :: a -> [b] -> NonEmpty c
cons = a -> [b] -> NonEmpty c
forall a. a -> [a] -> NonEmpty a
(:|)

-------------------------------------------------------------------------------
-- containers
-------------------------------------------------------------------------------

-- | @since 0.1.3
instance Nil (S.Set a) where
    nil :: Set a
nil = Set a
forall a. Set a
S.empty

-- | @since 0.1.3
instance (Ord a, a ~ b, b ~ c) => Cons a (S.Set b) (S.Set c) where
    cons :: a -> Set b -> Set c
cons = a -> Set b -> Set c
forall a. Ord a => a -> Set a -> Set a
S.insert

-- | @since 0.1.3
instance Nil IS.IntSet where
    nil :: IntSet
nil = IntSet
IS.empty

-- | @since 0.1.3
instance Cons Int IS.IntSet IS.IntSet where
    cons :: Int -> IntSet -> IntSet
cons = Int -> IntSet -> IntSet
IS.insert

-- | @since 0.2
instance Nil (Seq.Seq a) where
    nil :: Seq a
nil = Seq a
forall a. Seq a
Seq.empty

-- | @since 0.2
instance (a ~ b, b ~ c) => Cons a (Seq.Seq b) (Seq.Seq c) where
    cons :: a -> Seq b -> Seq c
cons = a -> Seq b -> Seq c
forall a. a -> Seq a -> Seq a
(Seq.<|)

-- | @since 0.2
instance Nil (M.Map k v) where
    nil :: Map k v
nil = Map k v
forall k v. Map k v
M.empty

-- | @since 0.2
instance (Ord k, k ~ k1, k ~ k2, v ~ v1, v ~ v2) => Cons (k, v) (M.Map k1 v1) (M.Map k2 v2) where
    cons :: (k, v) -> Map k1 v1 -> Map k2 v2
cons ~(k
k, v
v) = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k v
v

-- | @since 0.2
instance Nil (IM.IntMap v) where
    nil :: IntMap v
nil = IntMap v
forall v. IntMap v
IM.empty

-- | @since 0.2
instance (i ~ Int, a ~ b, b ~ c) => Cons (i, a) (IM.IntMap b) (IM.IntMap c) where
    cons :: (i, a) -> IntMap b -> IntMap c
cons ~(i
i, a
x) = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert i
Int
i a
x

-------------------------------------------------------------------------------
-- vec
-------------------------------------------------------------------------------

instance n ~ 'N.Z => Nil (Vec.Vec n a) where
    nil :: Vec n a
nil = Vec n a
forall a. Vec 'Z a
Vec.VNil

instance (a ~ b, b ~ c, m ~ 'N.S n) => Cons a (Vec.Vec n b) (Vec.Vec m c) where
    cons :: a -> Vec n b -> Vec m c
cons = a -> Vec n b -> Vec m c
forall a (n1 :: Nat). a -> Vec n1 a -> Vec ('S n1) a
(Vec.:::)

-------------------------------------------------------------------------------
-- sop-core
-------------------------------------------------------------------------------

instance xs ~ '[] => Nil (NP f xs) where
    nil :: NP f xs
nil = NP f xs
forall k (a :: k -> *). NP a '[]
Nil

instance (f ~ g, g ~ h, xxs ~ (x ': xs)) => Cons (f x) (NP g xs)  (NP h xxs) where
    cons :: f x -> NP g xs -> NP h xxs
cons = f x -> NP g xs -> NP h xxs
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*)

instance xs ~ '[] => Nil (POP f xs) where
    nil :: POP f xs
nil =  NP (NP f) '[] -> POP f '[]
forall k (f :: k -> *) (xss :: [[k]]). NP (NP f) xss -> POP f xss
POP NP (NP f) '[]
forall k (a :: k -> *). NP a '[]
Nil

instance (f ~ g, g ~ h, xsxss ~ (xs ': xss)) => Cons (NP f xs) (POP g xss) (POP h xsxss) where
    cons :: NP f xs -> POP g xss -> POP h xsxss
cons = (NP f xs -> NP (NP f) xss -> NP (NP f) (xs : xss))
-> NP f xs -> POP g xss -> POP h xsxss
coerce (NP f xs -> NP (NP f) xss -> NP (NP f) (xs : xss)
forall x ys zs. Cons x ys zs => x -> ys -> zs
cons :: NP f xs -> NP (NP f) xss -> NP (NP f) (xs ': xss))

-------------------------------------------------------------------------------
-- ral
-------------------------------------------------------------------------------

instance Nil (RAL.RAList a) where
    nil :: RAList a
nil = RAList a
forall a. RAList a
RAL.empty

instance (a ~ b, a ~ c) => Cons a (RAL.RAList b) (RAL.RAList c) where
    cons :: a -> RAList b -> RAList c
cons = a -> RAList b -> RAList c
forall a. a -> RAList a -> RAList a
RAL.cons

instance (a ~ b, a ~ c) => Cons a (RAL.RAList b) (NERAL.NERAList c) where
    cons :: a -> RAList b -> NERAList c
cons a
x RAList b
RAL.Empty         = a -> NERAList a
forall a. a -> NERAList a
NERAL.singleton a
x
    cons a
x (RAL.NonEmpty NERAList b
xs) = a -> NERAList a -> NERAList a
forall a. a -> NERAList a -> NERAList a
NERAL.cons a
x NERAList a
NERAList b
xs

instance b ~ 'B.BZ => Nil (RAV.RAVec b a) where
    nil :: RAVec b a
nil = RAVec b a
forall a. RAVec 'BZ a
RAV.empty

instance (b ~ 'B.BP bb, bp ~ B.Pred bb, bb ~ B.Succ' bp) => Cons a (RAV.RAVec bp a) (RAV.RAVec b a) where
    cons :: a -> RAVec bp a -> RAVec b a
cons = a -> RAVec bp a -> RAVec b a
forall a (b :: Bin). a -> RAVec b a -> RAVec (Succ b) a
RAV.cons

instance (bp ~ B.Pred b, b ~ B.Succ' bp) => Cons a (RAV.RAVec bp a) (NERAV.NERAVec b a) where
    cons :: a -> RAVec bp a -> NERAVec b a
cons a
x RAVec bp a
RAV.Empty         = a -> NERAVec BinP1 a
forall a. a -> NERAVec BinP1 a
NERAV.singleton a
x
    cons a
x (RAV.NonEmpty NERAVec b1 a
xs) = a -> NERAVec b1 a -> NERAVec (Succ b1) a
forall a (b :: BinP). a -> NERAVec b a -> NERAVec (Succ b) a
NERAV.cons a
x NERAVec b1 a
xs