module AuxShellF where
import Fudgets
import TitleShellF(wmShellF')

auxShellF :: [Char] -> F c b -> F (Either Bool c) (Either Bool b)
auxShellF = (ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
forall c b.
(ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
auxShellF' ShellF -> ShellF
forall a. Customiser a
standard
delayedAuxShellF :: [Char] -> F c b -> F (Either Bool c) (Either Bool b)
delayedAuxShellF = (ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
forall c b.
(ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
delayedAuxShellF' ShellF -> ShellF
forall a. Customiser a
standard

delayedAuxShellF' :: (ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
delayedAuxShellF' ShellF -> ShellF
pm [Char]
title F c b
fud =
    (ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
forall c b.
(ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
auxShellF' ShellF -> ShellF
pm [Char]
title F c b
fud F (Either Bool c) (Either Bool b)
-> SP (Either Bool c) (Either Bool c)
-> F (Either Bool c) (Either Bool b)
forall c d e. F c d -> SP e c -> F e d
>=^^< SP (Either Bool c) (Either Bool c)
forall b. SP (Either Bool b) (Either Bool b)
emptyDownSP
  where
    -- 3x3 state transition table:
    emptyDownSP :: SP (Either Bool b) (Either Bool b)
emptyDownSP = SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
forall b b.
SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
getPopSP SP (Either Bool b) (Either Bool b)
emptyDownSP SP (Either Bool b) (Either Bool b)
upSP      b -> SP (Either Bool b) (Either Bool b)
downSP
    downSP :: b -> SP (Either Bool b) (Either Bool b)
downSP    b
x = SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
forall b b.
SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
getPopSP (b -> SP (Either Bool b) (Either Bool b)
downSP b
x)  (b -> SP (Either Bool b) (Either Bool b)
msgSP b
x) b -> SP (Either Bool b) (Either Bool b)
downSP
    upSP :: SP (Either Bool b) (Either Bool b)
upSP        = SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
forall b b.
SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
getPopSP SP (Either Bool b) (Either Bool b)
emptyDownSP SP (Either Bool b) (Either Bool b)
upSP      b -> SP (Either Bool b) (Either Bool b)
msgSP

    msgSP :: b -> SP (Either Bool b) (Either Bool b)
msgSP b
x = Either Bool b
-> SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
forall b a. b -> SP a b -> SP a b
putSP (b -> Either Bool b
forall a b. b -> Either a b
Right b
x) SP (Either Bool b) (Either Bool b)
upSP

    getPopSP :: SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
-> (b -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
getPopSP SP (Either Bool b) (Either Bool b)
downSP SP (Either Bool b) (Either Bool b)
upSP b -> SP (Either Bool b) (Either Bool b)
msgSP = Cont (SP (Either Bool b) (Either Bool b)) (Either Bool b)
forall a b. Cont (SP a b) a
getSP Cont (SP (Either Bool b) (Either Bool b)) (Either Bool b)
-> Cont (SP (Either Bool b) (Either Bool b)) (Either Bool b)
forall a b. (a -> b) -> a -> b
$ (Bool -> SP (Either Bool b) (Either Bool b))
-> (b -> SP (Either Bool b) (Either Bool b))
-> Either Bool b
-> SP (Either Bool b) (Either Bool b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Bool -> SP (Either Bool b) (Either Bool b)
popSP b -> SP (Either Bool b) (Either Bool b)
msgSP
      where popSP :: Bool -> SP (Either Bool b) (Either Bool b)
popSP Bool
b = Either Bool b
-> SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
forall b a. b -> SP a b -> SP a b
putSP (Bool -> Either Bool b
forall a b. a -> Either a b
Left Bool
b) (SP (Either Bool b) (Either Bool b)
 -> SP (Either Bool b) (Either Bool b))
-> SP (Either Bool b) (Either Bool b)
-> SP (Either Bool b) (Either Bool b)
forall a b. (a -> b) -> a -> b
$ if Bool
b then SP (Either Bool b) (Either Bool b)
upSP else SP (Either Bool b) (Either Bool b)
downSP

auxShellF' :: (ShellF -> ShellF)
-> [Char] -> F c b -> F (Either Bool c) (Either Bool b)
auxShellF' ShellF -> ShellF
pm [Char]
title F c b
fud =
  (() -> Bool) -> (b -> b) -> Either () b -> Either Bool b
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
False) b -> b
forall a. Customiser a
id (Either () b -> Either Bool b)
-> F (Either (Either [Char] Bool) c) (Either () b)
-> F (Either (Either [Char] Bool) c) (Either Bool b)
forall a b e. (a -> b) -> F e a -> F e b
>^=<
  (ShellF -> ShellF)
-> [Char]
-> F c b
-> F (Either (Either [Char] Bool) c) (Either () b)
forall c d.
(ShellF -> ShellF)
-> [Char]
-> F c d
-> F (Either (Either [Char] Bool) c) (Either () d)
wmShellF' (ShellF -> ShellF
pm (ShellF -> ShellF) -> (ShellF -> ShellF) -> ShellF -> ShellF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShellF -> ShellF
forall xxx. HasVisible xxx => Bool -> Customiser xxx
setVisible Bool
False) [Char]
title F c b
fud
  F (Either (Either [Char] Bool) c) (Either Bool b)
-> (Either Bool c -> Either (Either [Char] Bool) c)
-> F (Either Bool c) (Either Bool b)
forall c d e. F c d -> (e -> c) -> F e d
>=^< (Bool -> Either [Char] Bool)
-> (c -> c) -> Either Bool c -> Either (Either [Char] Bool) c
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither Bool -> Either [Char] Bool
forall a b. b -> Either a b
Right c -> c
forall a. Customiser a
id

{-
auxShellF lbl title fud =
  loopThroughRightF
    (wmShellF' (setVisible False) title fud)
    (Right>^=<toggleButtonF lbl>=^<const False)
-}