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 = mapFilterSP lift `serCompSP` ipSP (Nothing,Nothing)
  where
    ipSP optvalues = getSP $ either (change setFst) (change setSnd)
      where
	change setOne inputmsg =
	    putSP (mapInp (const optvalues') inputmsg) $
	    ipSP optvalues'
	  where
	    optvalues' = setOne optvalues (Just $ stripInputMsg inputmsg)

    lift = liftMaybeInputMsg . mapInp liftMaybePair

    liftMaybePair (Just x,Just y) = Just (x,y)
    liftMaybePair _               = Nothing

    liftMaybeInputMsg m = fmap im (stripInputMsg m)
      where im x = mapInp (const x) 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 tags = ilSP [(tag,Nothing)|tag<-tags]
  where
    ilSP acc =
        getSP $ \(t,msg) ->
          case msg of
	    InputChange x -> change t InputChange x
	    InputDone k x -> change t (InputDone k) x
      where
        change t f x = putsSP [f [(t,x)|(t,Just x)<-acc']] (ilSP acc')
	  where acc' = replace (t,Just x) acc


stripInputSP = mapFilterSP notLeave
  where 
    notLeave (InputChange s) = Just s
    notLeave (InputDone k s) = if k == inputLeaveKey
                               then Nothing
			       else Just s

inputDoneSP = mapFilterSP inputDone
inputLeaveDoneSP = mapFilterSP inputLeaveDone