Longest palindromic substring (WIP)

LPS.hs

{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
import Data.List
import Data.Ord

isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = xs == reverse xs

lps, lps' :: Eq a => [a] -> [a]
lps = maximumBy (comparing length) . filter isPalindrome . subsequences

-- In the recursive case two things might happen:
-- (1) The lps stays the same: ...abc...cba...
-- (2) A new lps appears:      abc...cba...
--
-- Example:
--
-- abbabba
--
--       a (2)
--      _a (1)
--     bb_ (2)
--    abba (2)
--   _abba (1)
--  bbabb_ (2)
-- abbabba (2)
--
--    |||
--    |a||
--    |a||
--    |a||
--    | ||a
--    |b|a
--   b| |b|a
--  ab| |ba|
--   b|a|b|ba
--  bb|a|bb|a
-- abb|a|bba|

--------------------------------------------------------------------------------
-- FROM HERE ON WE ASSUME DISTINCT NEIGHBORS
-- TO RECOVER GENERAL SOLUTION: USE RUN-LENGTH ENCODING
--------------------------------------------------------------------------------

data PP a = PP
  { left :: [a]
  , pivot :: a
  , right :: [a]
  , remaining :: [a]
  -- invariant A: input == left ++ [pivot] ++ right ++ remaining
  -- invariant B: left  == reverse right
  } deriving Show

singletonPP :: a -> PP a
singletonPP x = PP [] x [] []

snoc :: [a] -> a -> [a]
snoc xs x = xs ++ [x]

unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Nothing
unsnoc (x0:xs) = Just (go x0 xs) where
  go x [] = ([], x)
  go x (y:ys) = (\(a,b) -> (x:a, b)) (go y ys)

pattern (:|>) :: [a] -> a -> [a]
pattern xs :|> x <- (unsnoc -> Just (xs,x)) where
  xs :|> x = xs ++ [x]
{-# COMPLETE (:|>), [] #-}

-- if all consecutive elements are distinct then there are only five cases (the middle three are essentially the same):
extend :: Eq a => a -> PP a -> PP a
extend x (PP l p r (y : ys)) | x == y = PP (x : l) p (r :|> y) ys
extend x (PP (p':y:l) p r ys) | x == y = PP [x] p' [y] (l ++ [p] ++ r ++ ys)
extend x (PP [p'] y r ys)     | x == y = PP [x] p' [y] (r ++ ys)
extend x (PP [] p' (y:r) ys)  | x == y = PP [x] p' [y] (r ++ ys)
extend x (PP l p r ys) = PP [] x [] (l ++ [p] ++ r ++ ys)

lps' = undefined