{-# Language FunctionalDependencies,MultiParamTypeClasses #-}

import Data.Functor.Apply
import Data.Functor.Identity
import Data.Maybe (fromJust)

class GetS_r r f | f -> r where
 getS_r :: f a -> (r a,Maybe (f a))

class SetS_r r f | f -> r  where
 setS_r :: (r a,Maybe (f a)) -> f a

--

type SafeState   s a = s -> (a, Maybe s)
type CoSafeState s a = (a, Maybe s) -> s

unfoldSafeState :: SafeState s a -> (CoSafeState b a) -> s ->  b
unfoldSafeState f c = go
 where
     go = c . fmap (fmap go) . f

linearDifference :: (GetS_r r t, SetS_r r' t', Apply f) => (r a -> f (r' b)) -> SafeState (t a) (f (Maybe (t' b) -> t' b))
linearDifference f xs = (\(x,xs')->(fmap (curry setS_r) (f x),xs')) (getS_r xs)

traverse1Default :: (GetS_r r t, SetS_r r' t', Apply f) => (r a -> f (r' b)) -> t a -> f (t' b)
traverse1Default f = unfoldSafeState (c f) g
 where
  g :: Apply f => CoSafeState (f (t' b)) (f (Maybe (t' b) -> t' b))
  g (h,Nothing) = fmap (\h' -> h' Nothing) h
  g (h,Just xs) = liftF2 (\f x ->f (Just x)) h xs -- is this lifting of Just slow?

--

infixr 5 :|

data NonEmpty a = a :| NonEmpty a | End a deriving (Show,Eq, Ord)

instance GetS_r Identity NonEmpty where
 getS_r (x :| xs) = (Identity x,Just xs)
 getS_r (End x) = (Identity x,Nothing)

instance SetS_r Identity NonEmpty where
 setS_r (Identity x,Just xs) = (x :| xs)
 setS_r (Identity x,Nothing) = (End x)

--

eg :: NonEmpty Int
eg = 1 :| 2 :| 3 :| End 4

test :: NonEmpty Int
test = runIdentity $ traverse1Default Identity eg