{-# 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 = 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)
oldConfirmPopupF :: F String (String, ConfirmMsg)
oldConfirmPopupF = 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)

-- Grr! Type signatures required because of the mononorphism restriction
confirmPopupF :: Graphic msg => F msg (msg,ConfirmMsg)
messagePopupF :: Graphic msg => F msg (msg,Click)
confirmPopupF :: forall msg. Graphic msg => F msg (msg, ConfirmMsg)
confirmPopupF = forall {a} {c} {b}. Graphic a => F c b -> F a (a, b)
msgPopupF F ConfirmMsg ConfirmMsg
confirm
messagePopupF :: forall msg. Graphic msg => F msg (msg, Click)
messagePopupF = 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 =
    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

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' =
    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')

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' =
    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')

stringPopupOptF :: String
-> F (Maybe String, Maybe String)
     ((Maybe String, Maybe String), Maybe String)
stringPopupOptF = 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' = 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 = 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' = 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 :: 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 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)))

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 = 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
       -- 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 = 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__
-- nhc bug workaround
blaha=undefined::DisplayF
#endif