module InputSP where
import InputMsg
import Spops
import CompSP(serCompSP)
import SpEither(mapFilterSP)
import Utils(replace,setFst,setSnd)

-- New version: works with abstract InputMsg.
inputPairSP :: SP (Either (InputMsg a) (InputMsg b)) (InputMsg (a, b))
inputPairSP = (InputMsg (Maybe a, Maybe b) -> Maybe (InputMsg (a, b)))
-> SP (InputMsg (Maybe a, Maybe b)) (InputMsg (a, b))
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP InputMsg (Maybe a, Maybe b) -> Maybe (InputMsg (a, b))
forall a b. InputMsg (Maybe a, Maybe b) -> Maybe (InputMsg (a, b))
lift SP (InputMsg (Maybe a, Maybe b)) (InputMsg (a, b))
-> SP
     (Either (InputMsg a) (InputMsg b)) (InputMsg (Maybe a, Maybe b))
-> SP (Either (InputMsg a) (InputMsg b)) (InputMsg (a, b))
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
`serCompSP` (Maybe a, Maybe b)
-> SP
     (Either (InputMsg a) (InputMsg b)) (InputMsg (Maybe a, Maybe b))
forall a a.
(Maybe a, Maybe a)
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
ipSP (Maybe a
forall a. Maybe a
Nothing,Maybe b
forall a. Maybe a
Nothing)
  where
    ipSP :: (Maybe a, Maybe a)
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
ipSP (Maybe a, Maybe a)
optvalues = Cont
  (SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a)))
  (Either (InputMsg a) (InputMsg a))
forall a b. Cont (SP a b) a
getSP Cont
  (SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a)))
  (Either (InputMsg a) (InputMsg a))
-> Cont
     (SP
        (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a)))
     (Either (InputMsg a) (InputMsg a))
forall a b. (a -> b) -> a -> b
$ (InputMsg a
 -> SP
      (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a)))
-> (InputMsg a
    -> SP
         (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a)))
-> Either (InputMsg a) (InputMsg a)
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (((Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a))
-> InputMsg a
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
forall a.
((Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a))
-> InputMsg a
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
change (Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a)
forall a1 b a2. (a1, b) -> a2 -> (a2, b)
setFst) (((Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a))
-> InputMsg a
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
forall a.
((Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a))
-> InputMsg a
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
change (Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a)
forall a b1 b2. (a, b1) -> b2 -> (a, b2)
setSnd)
      where
	change :: ((Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a))
-> InputMsg a
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
change (Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a)
setOne InputMsg a
inputmsg =
	    InputMsg (Maybe a, Maybe a)
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
forall b a. b -> SP a b -> SP a b
putSP ((a -> (Maybe a, Maybe a))
-> InputMsg a -> InputMsg (Maybe a, Maybe a)
forall t a. (t -> a) -> InputMsg t -> InputMsg a
mapInp ((Maybe a, Maybe a) -> a -> (Maybe a, Maybe a)
forall a b. a -> b -> a
const (Maybe a, Maybe a)
optvalues') InputMsg a
inputmsg) (SP
   (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
 -> SP
      (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a)))
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
forall a b. (a -> b) -> a -> b
$
	    (Maybe a, Maybe a)
-> SP
     (Either (InputMsg a) (InputMsg a)) (InputMsg (Maybe a, Maybe a))
ipSP (Maybe a, Maybe a)
optvalues'
	  where
	    optvalues' :: (Maybe a, Maybe a)
optvalues' = (Maybe a, Maybe a) -> Maybe a -> (Maybe a, Maybe a)
setOne (Maybe a, Maybe a)
optvalues (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ InputMsg a -> a
forall p. InputMsg p -> p
stripInputMsg InputMsg a
inputmsg)

    lift :: InputMsg (Maybe a, Maybe b) -> Maybe (InputMsg (a, b))
lift = InputMsg (Maybe (a, b)) -> Maybe (InputMsg (a, b))
forall (f :: * -> *) a.
Functor f =>
InputMsg (f a) -> f (InputMsg a)
liftMaybeInputMsg (InputMsg (Maybe (a, b)) -> Maybe (InputMsg (a, b)))
-> (InputMsg (Maybe a, Maybe b) -> InputMsg (Maybe (a, b)))
-> InputMsg (Maybe a, Maybe b)
-> Maybe (InputMsg (a, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe a, Maybe b) -> Maybe (a, b))
-> InputMsg (Maybe a, Maybe b) -> InputMsg (Maybe (a, b))
forall t a. (t -> a) -> InputMsg t -> InputMsg a
mapInp (Maybe a, Maybe b) -> Maybe (a, b)
forall a b. (Maybe a, Maybe b) -> Maybe (a, b)
liftMaybePair

    liftMaybePair :: (Maybe a, Maybe b) -> Maybe (a, b)
liftMaybePair (Just a
x,Just b
y) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
x,b
y)
    liftMaybePair (Maybe a, Maybe b)
_               = Maybe (a, b)
forall a. Maybe a
Nothing

    liftMaybeInputMsg :: InputMsg (f a) -> f (InputMsg a)
liftMaybeInputMsg InputMsg (f a)
m = (a -> InputMsg a) -> f a -> f (InputMsg a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> InputMsg a
forall a. a -> InputMsg a
im (InputMsg (f a) -> f a
forall p. InputMsg p -> p
stripInputMsg InputMsg (f a)
m)
      where im :: a -> InputMsg a
im a
x = (f a -> a) -> InputMsg (f a) -> InputMsg a
forall t a. (t -> a) -> InputMsg t -> InputMsg a
mapInp (a -> f a -> a
forall a b. a -> b -> a
const a
x) InputMsg (f a)
m

{- -- old version:
inputPairSP = ipSP Nothing Nothing
  where
    ipSP optx opty =
        getSP $ \msg ->
          case msg of
	    Left (InputChange x) -> changeL InputChange x
	    Left (InputDone k x) -> changeL (InputDone k) x
	    Right (InputChange y) -> changeR InputChange y
	    Right (InputDone k y) -> changeR (InputDone k) y
      where
        changeL f x =
            case opty of
	      Just y -> putsSP [f (x,y)] cont
	      Nothing -> cont
	  where cont = ipSP (Just x) opty
        changeR f y =
            case optx of
	      Just x -> putsSP [f (x,y)] cont
	      Nothing -> cont
	  where cont = ipSP optx (Just y)
-}

inputListSP :: [a] -> SP (a, InputMsg b) (InputMsg [(a, b)])
inputListSP [a]
tags = [(a, Maybe b)] -> SP (a, InputMsg b) (InputMsg [(a, b)])
forall a b.
Eq a =>
[(a, Maybe b)] -> SP (a, InputMsg b) (InputMsg [(a, b)])
ilSP [(a
tag,Maybe b
forall a. Maybe a
Nothing)|a
tag<-[a]
tags]
  where
    ilSP :: [(a, Maybe b)] -> SP (a, InputMsg b) (InputMsg [(a, b)])
ilSP [(a, Maybe b)]
acc =
        Cont (SP (a, InputMsg b) (InputMsg [(a, b)])) (a, InputMsg b)
forall a b. Cont (SP a b) a
getSP Cont (SP (a, InputMsg b) (InputMsg [(a, b)])) (a, InputMsg b)
-> Cont (SP (a, InputMsg b) (InputMsg [(a, b)])) (a, InputMsg b)
forall a b. (a -> b) -> a -> b
$ \(a
t,InputMsg b
msg) ->
          case InputMsg b
msg of
	    InputChange b
x -> a
-> ([(a, b)] -> InputMsg [(a, b)])
-> b
-> SP (a, InputMsg b) (InputMsg [(a, b)])
change a
t [(a, b)] -> InputMsg [(a, b)]
forall a. a -> InputMsg a
InputChange b
x
	    InputDone KeySym
k b
x -> a
-> ([(a, b)] -> InputMsg [(a, b)])
-> b
-> SP (a, InputMsg b) (InputMsg [(a, b)])
change a
t (KeySym -> [(a, b)] -> InputMsg [(a, b)]
forall a. KeySym -> a -> InputMsg a
InputDone KeySym
k) b
x
      where
        change :: a
-> ([(a, b)] -> InputMsg [(a, b)])
-> b
-> SP (a, InputMsg b) (InputMsg [(a, b)])
change a
t [(a, b)] -> InputMsg [(a, b)]
f b
x = [InputMsg [(a, b)]]
-> SP (a, InputMsg b) (InputMsg [(a, b)])
-> SP (a, InputMsg b) (InputMsg [(a, b)])
forall b a. [b] -> SP a b -> SP a b
putsSP [[(a, b)] -> InputMsg [(a, b)]
f [(a
t,b
x)|(a
t,Just b
x)<-[(a, Maybe b)]
acc']] ([(a, Maybe b)] -> SP (a, InputMsg b) (InputMsg [(a, b)])
ilSP [(a, Maybe b)]
acc')
	  where acc' :: [(a, Maybe b)]
acc' = (a, Maybe b) -> [(a, Maybe b)] -> [(a, Maybe b)]
forall a b. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
replace (a
t,b -> Maybe b
forall a. a -> Maybe a
Just b
x) [(a, Maybe b)]
acc


stripInputSP :: SP (InputMsg b) b
stripInputSP = (InputMsg b -> Maybe b) -> SP (InputMsg b) b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP InputMsg b -> Maybe b
forall a. InputMsg a -> Maybe a
notLeave
  where 
    notLeave :: InputMsg a -> Maybe a
notLeave (InputChange a
s) = a -> Maybe a
forall a. a -> Maybe a
Just a
s
    notLeave (InputDone KeySym
k a
s) = if KeySym
k KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
inputLeaveKey
                               then Maybe a
forall a. Maybe a
Nothing
			       else a -> Maybe a
forall a. a -> Maybe a
Just a
s

inputDoneSP :: SP (InputMsg b) b
inputDoneSP = (InputMsg b -> Maybe b) -> SP (InputMsg b) b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP InputMsg b -> Maybe b
forall a. InputMsg a -> Maybe a
inputDone
inputLeaveDoneSP :: SP (InputMsg b) b
inputLeaveDoneSP = (InputMsg b -> Maybe b) -> SP (InputMsg b) b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP InputMsg b -> Maybe b
forall a. InputMsg a -> Maybe a
inputLeaveDone