{-# Language GADTs , KindSignatures , DataKinds , ConstraintKinds , TypeApplications , RankNTypes , ScopedTypeVariables #-}
module DLink where

data DList a where
 DList :: DList a -> a -> DList a -> DList a

toDList :: [a] -> DList a
toDList xs = first
 where
  (last,first) = go last xs first
  go :: DList a -> [a] -> DList a -> (DList a, DList a)
  go prev []     next = (prev,next)
  go prev (x:xs) next = (last,this) 
   where 
    this = DList prev x rest
    (last,rest) = go this xs next
                              
takeDList :: Int -> DList a -> [a]
takeDList 1 (DList _ a _) = [a]
takeDList n (DList _ x xs) = x : takeDList (n-1) xs

displayDList :: Show a => Int -> DList a -> String
displayDList n xs = show $ takeDList n xs 

test1 :: String
test1 = displayDList 4 $ toDList [1,2,3]

{-
*DLink> test1
"[1,2,3,1]"
-}

{-
 the reason this works is because 
 when the list is being consumed,
 the "end" is clear
 however, cons cannot be implemented to add nodes to the DList
 since it would not be able to detect "last".
 need a new version of DList to record the Cycle
-}

type CycleConstraint c = (FromCycle c,ToCycle c) 

data Cycle (cycle :: Bool) a where
 CycleNode :: (CycleConstraint c1,CycleConstraint c2) => Cycle c1 a -> a -> Cycle c2 a -> Cycle 'False a
 CycleLink :: (CycleConstraint c1,CycleConstraint c2) => Cycle c1 a -> a -> Cycle c2 a -> Cycle 'True a

toCycle :: forall b a. (ToCycle b, FromCycle b) => [a] -> Cycle b a
toCycle xs = first
 where
  (last,first) = toCycle' last xs first

class ToCycle (b :: Bool) where
 toCycle' :: (CycleConstraint b1,CycleConstraint b2) =>Cycle b1 a -> [a] -> Cycle b2 a -> (Cycle 'True a,Cycle b a)

instance ToCycle 'True where
 toCycle'  prev (x:[]) next = let this = CycleLink prev x next in (this,this) 

instance ToCycle 'False where 
 toCycle' prev (x:(xs@(_ : (_ : _)))) next = (last,this) 
   where 
    this = CycleNode prev x rest
    (last,rest) = toCycle' @False this xs next
 toCycle' prev (x:(xs@(_ : []))) next = (last,this) 
   where 
    this = CycleNode prev x rest
    (last,rest) = toCycle' @True this xs next