{-# LANGUAGE CPP #-}
module DialogF(inputPopupOptF, inputPopupF, passwdPopupOptF,
               passwdPopupF, stringPopupOptF, stringPopupF,
	       confirmPopupF, ConfirmMsg(..),
	       oldConfirmPopupF, oldMessagePopupF,
               messagePopupF) where
import Spacer(marginHVAlignF,marginF)
import Alignment
import PushButtonF(Click(..))
import DButtonF
import FDefaults
import CompOps
import CompSP(preMapSP)
import Defaults(labelFont,bgColor,defaultSep)--buttonFont,fgColor,
import CmdLineEnv(argFlag)
import DDisplayF
import PopupF(popupShellF)
import Fudget
import Geometry(pP)
import Spops
import SpEither(filterJustSP,filterRightSP)
import StringF
import InputF(InF(..))
import InputMsg(ConfirmMsg(..),toConfirm,fromConfirm,InputMsg(..),inputLeaveKey)
--import EitherUtils(isM)
import Data.Maybe(isJust,maybeToList)
--import TextF(textF')
--import ListRequest(replaceAll)
--import NullF(startupF)
import Placer(vBoxF,hBoxF)
import AutoPlacer(autoP')
import Sizing
import Xtypes() -- synonyms, for hbc
import Graphic -- instances (+ class Graphic, because of the monomorphism restr)
import Drawing
import GCAttrs() -- instances

default(Int)

oldMessagePopupF :: F String (String, Click)
oldMessagePopupF = String -> Maybe Point -> F String Click -> F String (String, Click)
forall a b. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
"Message" Maybe Point
forall a. Maybe a
Nothing (Int -> F Click Click -> F (Either String Click) Click
forall p c b. p -> F c b -> F (Either String c) b
labelabove Int
50 F Click Click
ok F (Either String Click) Click
-> (String -> Either String Click) -> F String Click
forall c d e. F c d -> (e -> c) -> F e d
>=^< String -> Either String Click
forall a b. a -> Either a b
Left)
oldConfirmPopupF :: F String (String, ConfirmMsg)
oldConfirmPopupF = String
-> Maybe Point
-> F String ConfirmMsg
-> F String (String, ConfirmMsg)
forall a b. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
"Confirm" Maybe Point
forall a. Maybe a
Nothing (Int
-> F ConfirmMsg ConfirmMsg
-> F (Either String ConfirmMsg) ConfirmMsg
forall p c b. p -> F c b -> F (Either String c) b
labelabove Int
50 F ConfirmMsg ConfirmMsg
confirm F (Either String ConfirmMsg) ConfirmMsg
-> (String -> Either String ConfirmMsg) -> F String ConfirmMsg
forall c d e. F c d -> (e -> c) -> F e d
>=^< String -> Either String ConfirmMsg
forall a b. a -> Either a b
Left)

-- Grr! Type signatures required because of the mononorphism restriction
confirmPopupF :: Graphic msg => F msg (msg,ConfirmMsg)
messagePopupF :: Graphic msg => F msg (msg,Click)
confirmPopupF :: F msg (msg, ConfirmMsg)
confirmPopupF = F ConfirmMsg ConfirmMsg -> F msg (msg, ConfirmMsg)
forall a c b. Graphic a => F c b -> F a (a, b)
msgPopupF F ConfirmMsg ConfirmMsg
confirm
messagePopupF :: F msg (msg, Click)
messagePopupF = F Click Click -> F msg (msg, Click)
forall a c b. Graphic a => F c b -> F a (a, b)
msgPopupF F Click Click
ok

msgPopupF :: F c b -> F a (a, b)
msgPopupF F c b
buttons =
    String -> Maybe Point -> F a b -> F a (a, b)
forall a b. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
"Confirm" Maybe Point
forall a. Maybe a
Nothing
      (SP (Either Any b) b
forall a1 b. SP (Either a1 b) b
filterRightSPSP (Either Any b) b
-> F (Either (Drawing Any a) c) (Either Any b)
-> F (Either (Drawing Any a) c) b
forall a b e. SP a b -> F e a -> F e b
>^^=< F (Either (Drawing Any a) c) (Either Any b)
-> F (Either (Drawing Any a) c) (Either Any b)
forall a b. F a b -> F a b
vBoxF (F (Drawing Any a) Any
forall a lbl b. Graphic a => F (Drawing lbl a) b
msgFF (Drawing Any a) Any
-> F c b -> F (Either (Drawing Any a) c) (Either Any b)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<F c b
buttons)F (Either (Drawing Any a) c) b
-> (a -> Either (Drawing Any a) c) -> F a b
forall c d e. F c d -> (e -> c) -> F e d
>=^<Drawing Any a -> Either (Drawing Any a) c
forall a b. a -> Either a b
Left (Drawing Any a -> Either (Drawing Any a) c)
-> (a -> Drawing Any a) -> a -> Either (Drawing Any a) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Drawing Any a
forall leaf lbl. leaf -> Drawing lbl leaf
layoutfix)
  where
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
    msgF :: Graphic a => F (Drawing lbl a) b
#endif
    msgF :: F (Drawing lbl a) b
msgF = Int
-> Alignment
-> Alignment
-> F (Drawing lbl a) b
-> F (Drawing lbl a) b
forall a b. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
5 Alignment
aCenter Alignment
aCenter (F (Drawing lbl a) b -> F (Drawing lbl a) b)
-> F (Drawing lbl a) b -> F (Drawing lbl a) b
forall a b. (a -> b) -> a -> b
$ Customiser (DisplayF (Drawing lbl a)) -> F (Drawing lbl a) b
forall a b. Graphic a => Customiser (DisplayF a) -> F a b
displayF' Customiser (DisplayF (Drawing lbl a))
pm
     where pm :: Customiser (DisplayF (Drawing lbl a))
pm = [String] -> Customiser (DisplayF (Drawing lbl a))
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor [String
bgColor,String
"white"] Customiser (DisplayF (Drawing lbl a))
-> Customiser (DisplayF (Drawing lbl a))
-> Customiser (DisplayF (Drawing lbl a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizing -> Customiser (DisplayF (Drawing lbl a))
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Dynamic Customiser (DisplayF (Drawing lbl a))
-> Customiser (DisplayF (Drawing lbl a))
-> Customiser (DisplayF (Drawing lbl a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		String -> Customiser (DisplayF (Drawing lbl a))
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
labelFont Customiser (DisplayF (Drawing lbl a))
-> Customiser (DisplayF (Drawing lbl a))
-> Customiser (DisplayF (Drawing lbl a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Customiser (DisplayF (Drawing lbl a))
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0
    layoutfix :: leaf -> Drawing lbl leaf
layoutfix = Placer -> Drawing lbl leaf -> Drawing lbl leaf
forall lbl leaf. Placer -> Drawing lbl leaf -> Drawing lbl leaf
PlacedD (Point -> Placer
autoP' (Int -> Int -> Point
pP Int
forall a. Num a => a
defaultSep Int
0)) (Drawing lbl leaf -> Drawing lbl leaf)
-> (leaf -> Drawing lbl leaf) -> leaf -> Drawing lbl leaf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. leaf -> Drawing lbl leaf
forall lbl leaf. leaf -> Drawing lbl leaf
AtomicD

genStringPopupOptF :: String
-> (b -> InF a b)
-> b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
genStringPopupOptF String
title b -> InF a b
inp b
default' =
    String
-> InF a b
-> Maybe b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
forall a b.
String
-> InF a b
-> Maybe b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
inputPopupOptF String
title (b -> InF a b
inp b
default') (b -> Maybe b
forall a. a -> Maybe a
Just b
default')

genStringPopupF :: String
-> (c -> InF a c)
-> c
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), c)
genStringPopupF String
title c -> InF a c
inp c
default' =
    F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe c)
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), c)
forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF (String
-> (c -> InF a c)
-> c
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe c)
forall b a.
String
-> (b -> InF a b)
-> b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
genStringPopupOptF String
title c -> InF a c
inp c
default')

stringPopupOptF :: String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
stringPopupOptF = String
-> (String -> InF String String)
-> String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
forall b a.
String
-> (b -> InF a b)
-> b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
genStringPopupOptF String
"String Entry" String -> InF String String
oldStringF
stringPopupF :: String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), String)
stringPopupF String
default' = F (Maybe String, Maybe String)
  ((Maybe String, Maybe String), Maybe String)
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), String)
forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF (String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
stringPopupOptF String
default')

passwdPopupOptF :: String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
passwdPopupOptF = String
-> (String -> InF String String)
-> String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
forall b a.
String
-> (b -> InF a b)
-> b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
genStringPopupOptF String
"Password Entry" String -> InF String String
oldPasswdF
passwdPopupF :: String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), String)
passwdPopupF String
default' = F (Maybe String, Maybe String)
  ((Maybe String, Maybe String), Maybe String)
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), String)
forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF (String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
passwdPopupOptF String
default')

inputPopupOptF :: String -> InF a b -> Maybe b -> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
inputPopupOptF :: String
-> InF a b
-> Maybe b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
inputPopupOptF String
title InF a b
f Maybe b
default' =
    let stringconfirm :: F a (Maybe b)
stringconfirm =
            (Maybe b -> SP (Either (InputMsg b) ConfirmMsg) (Maybe b)
forall a. Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
filterDoneSP Maybe b
default' SP (Either (InputMsg b) ConfirmMsg) (Maybe b)
-> F (Either a ConfirmMsg) (Either (InputMsg b) ConfirmMsg)
-> F (Either a ConfirmMsg) (Maybe b)
forall a b e. SP a b -> F e a -> F e b
>^^=< F (Either a ConfirmMsg) (Either (InputMsg b) ConfirmMsg)
-> F (Either a ConfirmMsg) (Either (InputMsg b) ConfirmMsg)
forall a b. F a b -> F a b
vBoxF (InF a b
f InF a b
-> F ConfirmMsg ConfirmMsg
-> F (Either a ConfirmMsg) (Either (InputMsg b) ConfirmMsg)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F ConfirmMsg ConfirmMsg
confirm')) F (Either a ConfirmMsg) (Maybe b)
-> (a -> Either a ConfirmMsg) -> F a (Maybe b)
forall c d e. F c d -> (e -> c) -> F e d
>=^< a -> Either a ConfirmMsg
forall a b. a -> Either a b
Left
    in  String
-> Maybe Point
-> F (Maybe String, Maybe a) (Maybe b)
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
forall a b. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
title
		   Maybe Point
forall a. Maybe a
Nothing
		   (Int
-> F (Maybe String, Maybe a) (Maybe b)
-> F (Maybe String, Maybe a) (Maybe b)
forall a b. Int -> F a b -> F a b
marginF Int
5 ((Int -> F a (Maybe b) -> F (Either String a) (Maybe b)
forall p c b. p -> F c b -> F (Either String c) b
labelabove Int
50 F a (Maybe b)
stringconfirm F (Either String a) (Maybe b)
-> SP (Maybe String, Maybe a) (Either String a)
-> F (Maybe String, Maybe a) (Maybe b)
forall c d e. F c d -> SP e c -> F e d
>=^^< SP (Maybe String, Maybe a) (Either String a)
forall a b. SP (Maybe a, Maybe b) (Either a b)
distPairSP)))

inputPopupF :: String
-> InF a c
-> Maybe c
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), c)
inputPopupF String
title InF a c
f Maybe c
def = F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe c)
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), c)
forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF (String
-> InF a c
-> Maybe c
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe c)
forall a b.
String
-> InF a b
-> Maybe b
-> F (Maybe String, Maybe a) ((Maybe String, Maybe a), Maybe b)
inputPopupOptF String
title InF a c
f Maybe c
def)

button :: String -> lbl -> F Click Click
button String
k lbl
s = Customiser (ButtonF lbl) -> lbl -> F Click Click
forall lbl.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' ([(ModState, String)] -> Customiser (ButtonF lbl)
forall xxx. HasKeys xxx => [(ModState, String)] -> Customiser xxx
setKeys [([],String
k)]) lbl
s

button' :: String -> lbl -> F Click Click
button' String
k lbl
s =
  if String -> Bool -> Bool
argFlag String
"okkey" Bool
False
  then String -> lbl -> F Click Click
forall lbl. Graphic lbl => String -> lbl -> F Click Click
button String
k lbl
s
  else lbl -> F Click Click
forall lbl. Graphic lbl => lbl -> F Click Click
buttonF lbl
s
       -- This is a fix for the problem that when you press return in a
       -- stringPopupF, the next time the popup appears the string in it
       -- isn't selected.

#ifdef __HUGS__
label :: F String a -- for Hugs
#endif
label :: F String b
label = Customiser (DisplayF String) -> F String b
forall a b. Graphic a => Customiser (DisplayF a) -> F a b
displayF' Customiser (DisplayF String)
pm
  where pm :: Customiser (DisplayF String)
pm = Int -> Customiser (DisplayF String)
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0 Customiser (DisplayF String)
-> Customiser (DisplayF String) -> Customiser (DisplayF String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Customiser (DisplayF String)
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor [String
bgColor,String
"white"]Customiser (DisplayF String)
-> Customiser (DisplayF String) -> Customiser (DisplayF String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Customiser (DisplayF String)
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
labelFont

ok :: F Click Click
ok = Int -> Alignment -> Alignment -> F Click Click -> F Click Click
forall a b. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aLeft Alignment
aBottom (String -> String -> F Click Click
forall lbl. Graphic lbl => String -> lbl -> F Click Click
button String
"Return" String
"OK")
ok' :: F Click Click
ok' = Int -> Alignment -> Alignment -> F Click Click -> F Click Click
forall a b. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aLeft Alignment
aBottom (String -> String -> F Click Click
forall lbl. Graphic lbl => String -> lbl -> F Click Click
button' String
"Return" String
"OK")
cancel :: F Click Click
cancel = Int -> Alignment -> Alignment -> F Click Click -> F Click Click
forall a b. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aRight Alignment
aBottom (String -> String -> F Click Click
forall lbl. Graphic lbl => String -> lbl -> F Click Click
button String
"Escape" String
"Cancel")

confirm :: F ConfirmMsg ConfirmMsg
confirm = Either Click Click -> ConfirmMsg
forall a b. Either a b -> ConfirmMsg
toConfirm (Either Click Click -> ConfirmMsg)
-> F (Either Click Click) (Either Click Click)
-> F (Either Click Click) ConfirmMsg
forall a b e. (a -> b) -> F e a -> F e b
>^=< F (Either Click Click) (Either Click Click)
-> F (Either Click Click) (Either Click Click)
forall a b. F a b -> F a b
hBoxF (F Click Click
ok F Click Click
-> F Click Click -> F (Either Click Click) (Either Click Click)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F Click Click
cancel) F (Either Click Click) ConfirmMsg
-> (ConfirmMsg -> Either Click Click) -> F ConfirmMsg ConfirmMsg
forall c d e. F c d -> (e -> c) -> F e d
>=^< ConfirmMsg -> Either Click Click
fromConfirm
confirm' :: F ConfirmMsg ConfirmMsg
confirm' = Either Click Click -> ConfirmMsg
forall a b. Either a b -> ConfirmMsg
toConfirm (Either Click Click -> ConfirmMsg)
-> F (Either Click Click) (Either Click Click)
-> F (Either Click Click) ConfirmMsg
forall a b e. (a -> b) -> F e a -> F e b
>^=< F (Either Click Click) (Either Click Click)
-> F (Either Click Click) (Either Click Click)
forall a b. F a b -> F a b
hBoxF (F Click Click
ok' F Click Click
-> F Click Click -> F (Either Click Click) (Either Click Click)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F Click Click
cancel) F (Either Click Click) ConfirmMsg
-> (ConfirmMsg -> Either Click Click) -> F ConfirmMsg ConfirmMsg
forall c d e. F c d -> (e -> c) -> F e d
>=^< ConfirmMsg -> Either Click Click
fromConfirm

labelabove :: p -> F c b -> F (Either String c) b
labelabove p
len F c b
f = SP (Either Any b) b
forall a1 b. SP (Either a1 b) b
filterRightSP SP (Either Any b) b
-> F (Either String c) (Either Any b) -> F (Either String c) b
forall a b e. SP a b -> F e a -> F e b
>^^=< F (Either String c) (Either Any b)
-> F (Either String c) (Either Any b)
forall a b. F a b -> F a b
vBoxF (F String Any
forall b. F String b
label F String Any -> F c b -> F (Either String c) (Either Any b)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F c b
f)

filterMaybePairF :: (F a (b, Maybe c)) -> F a (b, c)
filterMaybePairF :: F a (b, Maybe c) -> F a (b, c)
filterMaybePairF F a (b, Maybe c)
f = SP (Maybe (b, c)) (b, c)
-> ((b, Maybe c) -> Maybe (b, c)) -> SP (b, Maybe c) (b, c)
forall a b t. SP a b -> (t -> a) -> SP t b
preMapSP SP (Maybe (b, c)) (b, c)
forall b. SP (Maybe b) b
filterJustSP (b, Maybe c) -> Maybe (b, c)
forall a b. (a, Maybe b) -> Maybe (a, b)
liftOpt SP (b, Maybe c) (b, c) -> F a (b, Maybe c) -> F a (b, c)
forall a b e. SP a b -> F e a -> F e b
>^^=< F a (b, Maybe c)
f

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

distPairSP :: SP (Maybe a, Maybe b) (Either a b)
distPairSP = ((Maybe a, Maybe b) -> [Either a b])
-> SP (Maybe a, Maybe b) (Either a b)
forall t b. (t -> [b]) -> SP t b
concmapSP (\(Maybe a
x, Maybe b
y) -> (a -> Either a b) -> Maybe a -> [Either a b]
forall a a. (a -> a) -> Maybe a -> [a]
otol a -> Either a b
forall a b. a -> Either a b
Left Maybe a
x [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ (b -> Either a b) -> Maybe b -> [Either a b]
forall a a. (a -> a) -> Maybe a -> [a]
otol b -> Either a b
forall a b. b -> Either a b
Right Maybe b
y)
  where otol :: (a -> a) -> Maybe a -> [a]
otol a -> a
f = Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Maybe a -> [a]) -> (Maybe a -> Maybe a) -> Maybe a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f

filterDoneSP :: Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
filterDoneSP =
    let fd :: Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd Maybe a
s =
            Cont
  (SP (Either (InputMsg a) ConfirmMsg) (Maybe a))
  (Either (InputMsg a) ConfirmMsg)
forall a b. Cont (SP a b) a
getSP Cont
  (SP (Either (InputMsg a) ConfirmMsg) (Maybe a))
  (Either (InputMsg a) ConfirmMsg)
-> Cont
     (SP (Either (InputMsg a) ConfirmMsg) (Maybe a))
     (Either (InputMsg a) ConfirmMsg)
forall a b. (a -> b) -> a -> b
$ \Either (InputMsg a) ConfirmMsg
msg ->
            let same :: SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
same = Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd Maybe a
s
            in case Either (InputMsg a) ConfirmMsg
msg of
	         Right ConfirmMsg
Confirm -> if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
s then Maybe a
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
forall b a. b -> SP a b -> SP a b
putSP Maybe a
s SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
same else SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
same
		 Right ConfirmMsg
Cancel -> Maybe a
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
forall b a. b -> SP a b -> SP a b
putSP Maybe a
forall a. Maybe a
Nothing SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
same
		 Left (InputChange a
s') -> Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd (a -> Maybe a
forall a. a -> Maybe a
Just a
s')
		 Left (InputDone String
k a
s') | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
inputLeaveKey -> Maybe a
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
forall b a. b -> SP a b -> SP a b
putSP (a -> Maybe a
forall a. a -> Maybe a
Just a
s') (SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
 -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a))
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
-> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
forall a b. (a -> b) -> a -> b
$
                                                              Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd (a -> Maybe a
forall a. a -> Maybe a
Just a
s')
                 Left InputMsg a
_ -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
same
    in  Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
forall a. Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd

#ifdef __NHC__
-- nhc bug workaround
blaha=undefined::DisplayF
#endif