{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Fcf.Data.AdjacencyMap where

import Fcf
import Fcf.Class.Bifunctor
import Fcf.Data.MapC (MapC (..))
import qualified Fcf.Data.MapC as MapC
import Fcf.Data.Nat
import qualified Fcf.Data.Set as S
import Fcf.Data.Symbol

newtype AdjacencyMap a = AM (MapC.MapC a (S.Set a))

-- | Empty
--
-- === __Example__
--
-- >>> :kind! (Eval Empty :: AdjacencyMap Nat)
-- (Eval Empty :: AdjacencyMap Nat) :: AdjacencyMap Nat
-- = 'AM ('MapC '[])
data Empty :: Exp (AdjacencyMap a)

type instance Eval Empty = 'AM (Eval MapC.Empty)

-- | Vertex
--
-- === __Example__
--
-- >>> :kind! (Eval (Vertex 1) :: AdjacencyMap Nat)
-- (Eval (Vertex 1) :: AdjacencyMap Nat) :: AdjacencyMap Nat
-- = 'AM ('MapC '[ '(1, 'S.Set '[])])
data Vertex :: a -> Exp (AdjacencyMap a)

type instance Eval (Vertex a) = 'AM (Eval (MapC.Singleton a =<< S.Empty))

-- | Edge
--
-- === __Example__
--
-- >>> :kind! (Eval (Edge 1 2) :: AdjacencyMap Nat)
-- (Eval (Edge 1 2) :: AdjacencyMap Nat) :: AdjacencyMap Nat
-- = 'AM ('MapC '[ '(1, 'S.Set '[2]), '(2, 'S.Set '[])])
data Edge :: a -> a -> Exp (AdjacencyMap a)

type instance
  Eval (Edge x y) =
    If
      (Eval (TyEq x y))
      ('AM (Eval (MapC.Singleton x =<< S.Singleton y)))
      ('AM (Eval (MapC.FromList ['(x, Eval (S.Singleton y)), '(y, Eval S.Empty)])))

-- | Overlay
--
-- === __Example__
--
-- >>> :kind! (Eval (Overlay (Eval (Vertex 1)) (Eval (Vertex 2))))
-- (Eval (Overlay (Eval (Vertex 1)) (Eval (Vertex 2)))) :: AdjacencyMap
--                                                           Nat
-- = 'AM ('MapC '[ '(2, 'S.Set '[]), '(1, 'S.Set '[])])
data Overlay :: AdjacencyMap a -> AdjacencyMap a -> Exp (AdjacencyMap a)

type instance Eval (Overlay ('AM x) ('AM y)) = 'AM (Eval (UnionWith S.Union x y))

-- | Connect
--
-- === __Example__
--
-- >>> :kind! (Eval (Connect (Eval (Vertex 1)) (Eval (Vertex 2))))
-- (Eval (Connect (Eval (Vertex 1)) (Eval (Vertex 2)))) :: AdjacencyMap
--                                                           Nat
-- = 'AM ('MapC '[ '(1, 'S.Set '[2]), '(2, 'S.Set '[])])
data Connect :: AdjacencyMap a -> AdjacencyMap a -> Exp (AdjacencyMap a)

type instance Eval (Connect ('AM x) ('AM y)) = 'AM (Eval (UnionsWith S.Union [x, y, Eval (FromSet (ConstFn (Eval (KeysSet y))) (Eval (KeysSet x)))]))

-- | IsEmpty
--
-- === __Example__
--
-- >>> :kind! (Eval (IsEmpty ('AM ('MapC '[]))))
-- (Eval (IsEmpty ('AM ('MapC '[])))) :: Bool
-- = 'True
data IsEmpty :: AdjacencyMap a -> Exp Bool

type instance Eval (IsEmpty ('AM x)) = Eval (MapC.Null x)

-- | HasVertex
--
-- === __Example__
--
-- >>> :kind! (Eval (HasVertex 1 (Eval (Vertex 1))))
-- (Eval (HasVertex 1 (Eval (Vertex 1)))) :: Bool
-- = 'True
data HasVertex :: a -> AdjacencyMap a -> Exp Bool

type instance Eval (HasVertex x ('AM y)) = Eval (MapC.Member x y)

-- | HasEdge
--
-- === __Example__
--
-- >>> :kind! (Eval (HasEdge 1 2 (Eval (Edge 1 2))))
-- (Eval (HasEdge 1 2 (Eval (Edge 1 2)))) :: Bool
-- = 'True
data HasEdge :: a -> a -> AdjacencyMap a -> Exp Bool

type instance Eval (HasEdge x y ('AM z)) = Eval (UnMaybe (Pure 'False) (S.Member y) =<< MapC.Lookup x z)

-- | VertexCount
--
-- === __Example__
--
-- >>> :kind! (Eval (VertexCount (Eval (Edge 1 2))))
-- (Eval (VertexCount (Eval (Edge 1 2)))) :: Nat
-- = 2
data VertexCount :: AdjacencyMap a -> Exp Nat

type instance Eval (VertexCount ('AM x)) = Eval (MapC.Size x)

-- | EdgeCount
--
-- === __Example__
--
-- >>> :kind! (Eval (EdgeCount (Eval (Edge 1 2))))
-- (Eval (EdgeCount (Eval (Edge 1 2)))) :: Nat
-- = 1
data EdgeCount :: AdjacencyMap a -> Exp Nat

type instance Eval (EdgeCount ('AM x)) = Eval (Fcf.Foldr (+) 0 =<< Map S.Size =<< MapC.Elems x)

-- | VertexList
--
-- === __Example__
--
-- >>> :kind! (Eval (VertexList (Eval (Edge 1 2))))
-- (Eval (VertexList (Eval (Edge 1 2)))) :: [Nat]
-- = '[1, 2]
data VertexList :: AdjacencyMap a -> Exp [a]

type instance Eval (VertexList ('AM x)) = Eval (MapC.Keys x)

-- | EdgeList
--
-- === __Example__
--
-- >>> :kind! (Eval (EdgeList (Eval (Connect (Eval (Vertex 1)) (Eval (Connect (Eval (Vertex 2)) (Eval (Vertex 3))))))))
-- (Eval (EdgeList (Eval (Connect (Eval (Vertex 1)) (Eval (Connect (Eval (Vertex 2)) (Eval (Vertex 3)))))))) :: [(Nat,
--                                                                                                                Nat)]
-- = '[ '(1, 2), '(1, 3), '(2, 3)]
data EdgeList :: AdjacencyMap a -> Exp [(a, a)]

type instance Eval (EdgeList ('AM x)) = Eval (EComb =<< Map (Second S.ToList) =<< MapC.ToList x)

data EComb :: [(x, [y])] -> Exp [(x, y)]

type instance Eval (EComb '[]) = '[]

type instance Eval (EComb ('(_, '[]) ': xs)) = Eval (EComb xs)

type instance Eval (EComb ('(x, y ': ys) ': xs)) = '(x, y) ': Eval (EComb ('(x, ys) ': xs))

-- | VertexSet
--
-- === __Example__
--
-- >>> :kind! (Eval (VertexSet (Eval (Edge 1 2))))
-- (Eval (VertexSet (Eval (Edge 1 2)))) :: S.Set Nat
-- = 'S.Set '[1, 2]
data VertexSet :: AdjacencyMap a -> Exp (S.Set a)

type instance Eval (VertexSet ('AM xs)) = Eval (KeysSet xs)

-- | EdgeSet
--
-- === __Example__
--
-- >>> :kind! (Eval (EdgeSet (Eval (Edge 1 2))))
-- (Eval (EdgeSet (Eval (Edge 1 2)))) :: S.Set (Nat, Nat)
-- = 'S.Set '[ '(1, 2)]
data EdgeSet :: AdjacencyMap a -> Exp (S.Set (a, a))

type instance Eval (EdgeSet xs) = Eval (S.FromList =<< EdgeList xs)

-- | AdjacencyList
--
-- === __Example__
--
-- >>> :kind! (Eval (AdjacencyList (Eval (Edge 1 2))))
-- (Eval (AdjacencyList (Eval (Edge 1 2)))) :: [(Nat, [Nat])]
-- = '[ '(1, '[2]), '(2, '[])]
data AdjacencyList :: AdjacencyMap a -> Exp [(a, [a])]

type instance Eval (AdjacencyList ('AM xs)) = Eval (Map (Map S.ToList) =<< MapC.ToList xs)

-- | UnionWith
--
-- === __Example__
--
-- >>> :kind! (Eval (UnionWith (++) (Eval (MapC.FromList ['(5, '["a"]), '(3, '["b"])])) (Eval (MapC.FromList ['(5, '["A"]), '(7, '["C"])]))))
-- (Eval (UnionWith (++) (Eval (MapC.FromList ['(5, '["a"]), '(3, '["b"])])) (Eval (MapC.FromList ['(5, '["A"]), '(7, '["C"])])))) :: MapC
--                                                                                                                                      Nat
--                                                                                                                                      [Symbol]
-- = 'MapC '[ '(5, '["a", "A"]), '(7, '["C"]), '(3, '["b"])]
data UnionWith :: (v -> v -> Exp v) -> MapC k v -> MapC k v -> Exp (MapC k v)

type instance
  Eval (UnionWith f ('MapC m1) m2) =
    Eval (Fcf.Foldr (UCombW f) m2 m1)

data UCombW :: (v -> v -> Exp v) -> (k, v) -> MapC k v -> Exp (MapC k v)

type instance
  Eval (UCombW f '(k, v) lst) =
    Eval (MapC.InsertWith f k v lst)

-- | UnionsWith
--
-- === __Example__
--
-- >>> :kind! (Eval (UnionsWith (++) ['MapC ['(5, '["a"]), '(3, '["b"])], 'MapC ['(5, '["A"]), '(7, '["C"])], 'MapC ['(5, '["e"]), '(7, '["o"])]]))
-- (Eval (UnionsWith (++) ['MapC ['(5, '["a"]), '(3, '["b"])], 'MapC ['(5, '["A"]), '(7, '["C"])], 'MapC ['(5, '["e"]), '(7, '["o"])]])) :: MapC
--                                                                                                                                            Nat
--                                                                                                                                            [Symbol]
-- = 'MapC '[ '(7, '["C", "o"]), '(5, '["a", "A", "e"]), '(3, '["b"])]
data UnionsWith :: (v -> v -> Exp v) -> [MapC k v] -> Exp (MapC k v)

type instance
  Eval (UnionsWith f xs) =
    Eval (Fcf.Foldr (UnionWith f) (Eval MapC.Empty) xs)

-- | FromSet
--
-- === __Example__
--
-- >>> :kind! (Eval (FromSet ((+) 1) ('S.Set [1,2,3])))
-- (Eval (FromSet ((+) 1) ('S.Set [1,2,3]))) :: MapC Nat Nat
-- = 'MapC '[ '(1, 2), '(2, 3), '(3, 4)]
data FromSet :: (k -> Exp a) -> S.Set k -> Exp (MapC k a)

type instance Eval (FromSet f ('S.Set xs)) = Eval (MapC.FromList $ Eval (Map (ToSnd f) xs))

-- | ToFst
--
-- === __Example__
--
-- >>> :kind! (Eval (ToFst Length ["f", "o", "o"]))
-- (Eval (ToFst Length ["f", "o", "o"])) :: (Nat, [Symbol])
-- = '(3, '["f", "o", "o"])
data ToFst :: (a -> Exp b) -> a -> Exp (b, a)

type instance Eval (ToFst f x) = '(Eval (f x), x)

-- | ToSnd
--
-- === __Example__
--
-- >>> :kind! (Eval (ToSnd Length ["f", "o", "o"]))
-- (Eval (ToSnd Length ["f", "o", "o"])) :: ([Symbol], Nat)
-- = '( '["f", "o", "o"], 3)
data ToSnd :: (a -> Exp b) -> a -> Exp (a, b)

type instance Eval (ToSnd f x) = '(x, Eval (f x))

-- | KeysSet
--
-- === __Example__
--
-- >>> :kind! (Eval (KeysSet ('MapC ['(5, "f"), '(3, "o")])))
-- (Eval (KeysSet ('MapC ['(5, "f"), '(3, "o")]))) :: S.Set Nat
-- = 'S.Set '[5, 3]
data KeysSet :: MapC k a -> Exp (S.Set k)

type instance Eval (KeysSet xs) = Eval (S.FromList =<< MapC.Keys xs)