{-# 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)
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 Data.Maybe(isJust,maybeToList)
import Placer(vBoxF,hBoxF)
import AutoPlacer(autoP')
import Sizing
import Xtypes()
import Graphic
import Drawing
import GCAttrs()
default(Int)
= forall {a} {b}. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
"Message" forall a. Maybe a
Nothing (forall {p} {c} {b}. p -> F c b -> F (Either String c) b
labelabove Int
50 F Click Click
ok forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left)
= forall {a} {b}. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
"Confirm" forall a. Maybe a
Nothing (forall {p} {c} {b}. p -> F c b -> F (Either String c) b
labelabove Int
50 F ConfirmMsg ConfirmMsg
confirm forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left)
confirmPopupF :: Graphic msg => F msg (msg,ConfirmMsg)
messagePopupF :: Graphic msg => F msg (msg,Click)
= forall {a} {c} {b}. Graphic a => F c b -> F a (a, b)
msgPopupF F ConfirmMsg ConfirmMsg
confirm
= forall {a} {c} {b}. Graphic a => F c b -> F a (a, b)
msgPopupF F Click Click
ok
F c b
buttons =
forall {a} {b}. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
"Confirm" forall a. Maybe a
Nothing
(forall {a1} {b}. SP (Either a1 b) b
filterRightSPforall a b e. SP a b -> F e a -> F e b
>^^=< forall {a} {b}. F a b -> F a b
vBoxF (forall a lbl b. Graphic a => F (Drawing lbl a) b
msgFforall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+<F c b
buttons)forall c d e. F c d -> (e -> c) -> F e d
>=^<forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a lbl b. Graphic a => F (Drawing lbl a) b
msgF = forall {a} {b}. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
5 Alignment
aCenter Alignment
aCenter forall a b. (a -> b) -> a -> b
$ forall {a} {b}. Graphic a => Customiser (DisplayF a) -> F a b
displayF' DisplayF (Drawing lbl a) -> DisplayF (Drawing lbl a)
pm
where pm :: DisplayF (Drawing lbl a) -> DisplayF (Drawing lbl a)
pm = forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor [String
bgColor,String
"white"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Dynamic forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
labelFont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0
layoutfix :: leaf -> Drawing lbl leaf
layoutfix = forall lbl leaf. Placer -> Drawing lbl leaf -> Drawing lbl leaf
PlacedD (Point -> Placer
autoP' (Int -> Int -> Point
pP forall a. Num a => a
defaultSep Int
0)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lbl leaf. leaf -> Drawing lbl leaf
AtomicD
String
title b -> InF a b
inp b
default' =
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') (forall a. a -> Maybe a
Just b
default')
String
title c -> InF a c
inp c
default' =
forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF (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')
= 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
String
default' = 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')
= 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
String
default' = 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)
String
title InF a b
f Maybe b
default' =
let stringconfirm :: F a (Maybe b)
stringconfirm =
(forall {a}.
Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
filterDoneSP Maybe b
default' forall a b e. SP a b -> F e a -> F e b
>^^=< forall {a} {b}. F a b -> F a b
vBoxF (InF a b
f forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< F ConfirmMsg ConfirmMsg
confirm')) forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left
in forall {a} {b}. String -> Maybe Point -> F a b -> F a (a, b)
popupShellF String
title
forall a. Maybe a
Nothing
(forall {a} {b}. Int -> F a b -> F a b
marginF Int
5 ((forall {p} {c} {b}. p -> F c b -> F (Either String c) b
labelabove Int
50 F a (Maybe b)
stringconfirm forall c d e. F c d -> SP e c -> F e d
>=^^< forall {a} {b}. SP (Maybe a, Maybe b) (Either a b)
distPairSP)))
String
title InF a c
f Maybe c
def = forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF (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 = forall {lbl}.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' (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 forall {lbl}. Graphic lbl => String -> lbl -> F Click Click
button String
k lbl
s
else forall {lbl}. Graphic lbl => lbl -> F Click Click
buttonF lbl
s
#ifdef __HUGS__
label :: F String a
#endif
label :: F String b
label = forall {a} {b}. Graphic a => Customiser (DisplayF a) -> F a b
displayF' DisplayF String -> DisplayF String
pm
where pm :: DisplayF String -> DisplayF String
pm = forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor [String
bgColor,String
"white"]forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
labelFont
ok :: F Click Click
ok = forall {a} {b}. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aLeft Alignment
aBottom (forall {lbl}. Graphic lbl => String -> lbl -> F Click Click
button String
"Return" String
"OK")
ok' :: F Click Click
ok' = forall {a} {b}. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aLeft Alignment
aBottom (forall {lbl}. Graphic lbl => String -> lbl -> F Click Click
button' String
"Return" String
"OK")
cancel :: F Click Click
cancel = forall {a} {b}. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aRight Alignment
aBottom (forall {lbl}. Graphic lbl => String -> lbl -> F Click Click
button String
"Escape" String
"Cancel")
confirm :: F ConfirmMsg ConfirmMsg
confirm = forall {a} {b}. Either a b -> ConfirmMsg
toConfirm forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {a} {b}. F a b -> F a b
hBoxF (F Click Click
ok forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< F Click Click
cancel) forall c d e. F c d -> (e -> c) -> F e d
>=^< ConfirmMsg -> Either Click Click
fromConfirm
confirm' :: F ConfirmMsg ConfirmMsg
confirm' = forall {a} {b}. Either a b -> ConfirmMsg
toConfirm forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {a} {b}. F a b -> F a b
hBoxF (F Click Click
ok' forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< F Click Click
cancel) 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 = forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=< forall {a} {b}. F a b -> F a b
vBoxF (forall {b}. F String b
label 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 :: forall a b c. F a (b, Maybe c) -> F a (b, c)
filterMaybePairF F a (b, Maybe c)
f = forall {a} {b} {t}. SP a b -> (t -> a) -> SP t b
preMapSP forall {b}. SP (Maybe b) b
filterJustSP forall {a} {b}. (a, Maybe b) -> Maybe (a, b)
liftOpt 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) = forall a. Maybe a
Nothing
liftOpt (a
x, Just b
y) = forall a. a -> Maybe a
Just (a
x, b
y)
distPairSP :: SP (Maybe a, Maybe b) (Either a b)
distPairSP = forall {t} {b}. (t -> [b]) -> SP t b
concmapSP (\(Maybe a
x, Maybe b
y) -> forall {a} {a}. (a -> a) -> Maybe a -> [a]
otol forall a b. a -> Either a b
Left Maybe a
x forall a. [a] -> [a] -> [a]
++ forall {a} {a}. (a -> a) -> Maybe a -> [a]
otol forall a b. b -> Either a b
Right Maybe b
y)
where otol :: (a -> a) -> Maybe a -> [a]
otol a -> a
f = forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a b. Cont (SP a b) a
getSP 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 forall a. Maybe a -> Bool
isJust Maybe a
s then 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 -> forall b a. b -> SP a b -> SP a b
putSP 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 (forall a. a -> Maybe a
Just a
s')
Left (InputDone String
k a
s') | String
k forall a. Eq a => a -> a -> Bool
/= String
inputLeaveKey -> forall b a. b -> SP a b -> SP a b
putSP (forall a. a -> Maybe a
Just a
s') forall a b. (a -> b) -> a -> b
$
Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd (forall a. a -> Maybe a
Just a
s')
Left InputMsg a
_ -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
same
in forall {a}.
Maybe a -> SP (Either (InputMsg a) ConfirmMsg) (Maybe a)
fd
#ifdef __NHC__
blaha=undefined::DisplayF
#endif