{-# language LambdaCase #-}
{-# language TypeFamilies #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}

---------------------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2017-2018
-- License   :  BSD-2-Clause OR Apache-2.0
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- Okasaki real-time queue modified for /O(1)/ @rel@
--
---------------------------------------------------------------------------------

module Queue
  ( Queue((:<),Empty)
  , snocQ
  , size
  , null
  ) where

import Control.Lens
import Data.Default
import Data.Function (on)
import Data.List (unfoldr)
import Data.Semigroup
import GHC.Exts as Exts
import Text.Read
import Prelude hiding (null)

import Relative
import Delta

-- @Q d f r s@ maintains @length s = length f - length r@
data Queue a = Q {-# unpack #-} !Delta [a] [a] [a]

instance Relative (Queue a) where
  rel 0 q = q
  rel d (Q d' f r s) = Q (d <> d') f r s

instance Default (Queue a) where
  def = Q 0 [] [] [] 

size :: Queue a -> Int
size (Q _ _ rs ss) = length ss + 2 * length rs

null :: Queue a -> Bool
null (Q _ [] _ _) = True
null _ = False

instance Relative a => IsList (Queue a) where
  type Item (Queue a) = a
  fromList = foldr cons def
  {-# inline fromList #-}
  toList = unfoldr uncons
  {-# inline toList #-}

instance AsEmpty (Queue a) where
  _Empty = prism (const $ Q 0 [] [] []) $ \case
    Q _ [] _ _ -> Right ()
    xs -> Left xs
  {-# inline _Empty #-}

instance (Relative a, Relative b) => Cons (Queue a) (Queue b) a b where
  _Cons = prism kons unkons where
    kons (a, Q d f r s) | a' <- rel (-d) a = Q d (a':f) r (a':s) 
    {-# inline conlike kons #-}
    unkons (Q _ [] _ _) = Left def
    unkons (Q d (x:f) r s) = Right (rel d x, exec d f r s)
  {-# inline _Cons #-}

snocQ :: Relative a => Queue a -> a -> Queue a
snocQ (Q d f r s) a = exec d f (rel (-d) a:r) s
{-# inline snocQ #-}

instance (Show a, Relative a) => Show (Queue a) where
  showsPrec d = showsPrec d . Exts.toList

instance (Read a, Relative a) => Read (Queue a) where
  readPrec = Exts.fromList <$> readPrec

instance (Eq a, Relative a) => Eq (Queue a) where
  (==) = (==) `on` Exts.toList
  {-# inline (==) #-}

instance (Ord a, Relative a) => Ord (Queue a) where
  compare = compare `on` Exts.toList
  {-# inline compare #-}

exec :: Delta -> [a] -> [a] -> [a] -> Queue a
exec d f r (_:s) = Q d f r s 
exec d f r [] = Q d f' [] f' where f' = rotate f r []
{-# inline exec #-}

rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y:_) a = y:a
rotate (x:xs) (y:ys) a = x : rotate xs ys (y:a)
rotate _ _ _ = error "Coda.Relative.Queue.rotate: invariant broken"