# Pastebin FWp4VlDt
{-# language ViewPatterns #-}
{-# language PatternSynonyms #-}
{-# language GADTs #-}
module Q where

import Data.Monoid
import Data.Foldable

c = 2 -- or 3

data Q a where
  Q :: [a] -> !Int -> [b] -> [a] -> !Int -> [c] -> Q a

instance Foldable Q where
  foldMap f (Q fs _ _ rs _ _) = foldMap f fs <> getDual (foldMap (Dual . f) rs)
  null (Q _ lf _ _ lr _) = lf + lr == 0
  length (Q _ lf _ _ lr _) = lf + lr
  toList (Q f _ _ r _ _) = f ++ reverse r

instance Show a => Show (Q a) where
  showsPrec d = showsPrec d . toList

rotateRev :: [a] -> [a] -> [a] -> [a]
rotateRev [] f a = reverse f ++ a
rotateRev (x:r) (splitAt c -> (p,q)) a = x : rotateRev r q (reverse p ++ a) where

rotateDrop :: [a] -> Int -> [a] -> [a]
rotateDrop r i f
  | i < c = rotateRev r (drop i f) []
  | otherwise = case r of
    (x:r') -> x : rotateDrop r' (i - c) (drop c f)

q :: [a] -> Int -> [b] -> [a] -> Int -> [c] -> Q a
q f lf sf r lr sr
  | lf > c*lr + 1, f' <- take i f, r' <- rotateDrop r i f = Q f' i f' r' j r'
  | lr > c*lf + 1, f' <- rotateDrop f j r, r' <- take j r = Q f' i f' r' j r'
  | otherwise = Q f lf sf r lr sr
  where i = div (lf + lr) 2; j = lf + lr - i

pattern Empty :: Q a
pattern Empty <- Q _ 0 _ _ 0 _ where
  Empty = Q [] 0 [] [] 0 []

uncons :: Q a -> Maybe (a, Q a)
uncons (Q [] _ _ [] _ _) = Nothing
uncons (Q [] _ _ (x:_) _ _) = Just (x, Empty)
uncons (Q (x:f) lf sf r lr sr) = Just (x, q f (lf-1) (drop 2 sf) r lr (drop 2 sr))

unsnoc :: Q a -> Maybe (Q a, a)
unsnoc (Q [] _ _ [] _ _) = Nothing
unsnoc (Q (x:_) _ _ [] _ _) = Just (Empty, x)
unsnoc (Q f lf sf (x:r) lr sr) = Just (q f lf (drop 2 sf) r (lr-1) (drop 2 sr), x)

-- cons
pattern (:<) :: a -> Q a -> Q a
pattern x :< xs <- (uncons -> Just (x, xs)) where
  x :< Q f lf sf r lr sr = q (x:f) (lf+1) (drop 1 sf) r lr (drop 1 sr)
infixr 5 :<

-- snoc
pattern (:>) :: Q a -> a -> Q a
pattern xs :> x <- (unsnoc -> Just (xs, x)) where
  Q f lf sf r lr sr :> x = q f lf (drop 1 sf) (x:r) (lr+1) (drop 1 sr)
infixl 5 :>

{-# complete Empty, (:>) #-}
{-# complete Empty, (:<) #-}