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 = forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP forall {a} {b}.
InputMsg (Maybe a, Maybe b) -> Maybe (InputMsg (a, b))
lift forall {a1} {b} {a2}. SP a1 b -> SP a2 a1 -> SP a2 b
`serCompSP` forall {t} {t}.
(Maybe t, Maybe t)
-> SP
     (Either (InputMsg t) (InputMsg t)) (InputMsg (Maybe t, Maybe t))
ipSP (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)
  where
    ipSP :: (Maybe t, Maybe t)
-> SP
     (Either (InputMsg t) (InputMsg t)) (InputMsg (Maybe t, Maybe t))
ipSP (Maybe t, Maybe t)
optvalues = forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {t}.
((Maybe t, Maybe t) -> Maybe t -> (Maybe t, Maybe t))
-> InputMsg t
-> SP
     (Either (InputMsg t) (InputMsg t)) (InputMsg (Maybe t, Maybe t))
change forall {a1} {b} {a2}. (a1, b) -> a2 -> (a2, b)
setFst) (forall {t}.
((Maybe t, Maybe t) -> Maybe t -> (Maybe t, Maybe t))
-> InputMsg t
-> SP
     (Either (InputMsg t) (InputMsg t)) (InputMsg (Maybe t, Maybe t))
change forall {a} {b1} {b2}. (a, b1) -> b2 -> (a, b2)
setSnd)
      where
	change :: ((Maybe t, Maybe t) -> Maybe t -> (Maybe t, Maybe t))
-> InputMsg t
-> SP
     (Either (InputMsg t) (InputMsg t)) (InputMsg (Maybe t, Maybe t))
change (Maybe t, Maybe t) -> Maybe t -> (Maybe t, Maybe t)
setOne InputMsg t
inputmsg =
	    forall b a. b -> SP a b -> SP a b
putSP (forall {t} {a}. (t -> a) -> InputMsg t -> InputMsg a
mapInp (forall a b. a -> b -> a
const (Maybe t, Maybe t)
optvalues') InputMsg t
inputmsg) forall a b. (a -> b) -> a -> b
$
	    (Maybe t, Maybe t)
-> SP
     (Either (InputMsg t) (InputMsg t)) (InputMsg (Maybe t, Maybe t))
ipSP (Maybe t, Maybe t)
optvalues'
	  where
	    optvalues' :: (Maybe t, Maybe t)
optvalues' = (Maybe t, Maybe t) -> Maybe t -> (Maybe t, Maybe t)
setOne (Maybe t, Maybe t)
optvalues (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. InputMsg a -> a
stripInputMsg InputMsg t
inputmsg)

    lift :: InputMsg (Maybe a, Maybe b) -> Maybe (InputMsg (a, b))
lift = forall {f :: * -> *} {a}.
Functor f =>
InputMsg (f a) -> f (InputMsg a)
liftMaybeInputMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {a}. (t -> a) -> InputMsg t -> InputMsg a
mapInp 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) = forall a. a -> Maybe a
Just (a
x,b
y)
    liftMaybePair (Maybe a, Maybe b)
_               = forall a. Maybe a
Nothing

    liftMaybeInputMsg :: InputMsg (f a) -> f (InputMsg a)
liftMaybeInputMsg InputMsg (f a)
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. a -> InputMsg a
im (forall {a}. InputMsg a -> a
stripInputMsg InputMsg (f a)
m)
      where im :: a -> InputMsg a
im a
x = forall {t} {a}. (t -> a) -> InputMsg t -> InputMsg a
mapInp (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 :: [p] -> SP (p, InputMsg p) (InputMsg [(p, p)])
inputListSP [p]
tags = forall {p} {p}.
Eq p =>
[(p, Maybe p)] -> SP (p, InputMsg p) (InputMsg [(p, p)])
ilSP [(p
tag,forall a. Maybe a
Nothing)|p
tag<-[p]
tags]
  where
    ilSP :: [(p, Maybe p)] -> SP (p, InputMsg p) (InputMsg [(p, p)])
ilSP [(p, Maybe p)]
acc =
        forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \(p
t,InputMsg p
msg) ->
          case InputMsg p
msg of
	    InputChange p
x -> p
-> ([(p, p)] -> InputMsg [(p, p)])
-> p
-> SP (p, InputMsg p) (InputMsg [(p, p)])
change p
t forall {a}. a -> InputMsg a
InputChange p
x
	    InputDone KeySym
k p
x -> p
-> ([(p, p)] -> InputMsg [(p, p)])
-> p
-> SP (p, InputMsg p) (InputMsg [(p, p)])
change p
t (forall a. KeySym -> a -> InputMsg a
InputDone KeySym
k) p
x
      where
        change :: p
-> ([(p, p)] -> InputMsg [(p, p)])
-> p
-> SP (p, InputMsg p) (InputMsg [(p, p)])
change p
t [(p, p)] -> InputMsg [(p, p)]
f p
x = forall b a. [b] -> SP a b -> SP a b
putsSP [[(p, p)] -> InputMsg [(p, p)]
f [(p
t,p
x)|(p
t,Just p
x)<-[(p, Maybe p)]
acc']] ([(p, Maybe p)] -> SP (p, InputMsg p) (InputMsg [(p, p)])
ilSP [(p, Maybe p)]
acc')
	  where acc' :: [(p, Maybe p)]
acc' = forall {a} {b}. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
replace (p
t,forall a. a -> Maybe a
Just p
x) [(p, Maybe p)]
acc


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

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