module Shells where

import FDefaults
import Fudget
import FRequest
import Xcommand
import DShellF
import EitherUtils
--import NullF
import CompOps
import Command
import FudgetIO
import Event
import Spops(concatMapSP)
import MapstateK

unmappedShellF :: t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedShellF t FRequest
cmds = (ShellF -> ShellF)
-> t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
forall (t :: * -> *) a b c d.
Foldable t =>
(ShellF -> ShellF)
-> t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedShellF' ShellF -> ShellF
forall a. Customiser a
standard t FRequest
cmds

unmappedShellF' :: (ShellF -> ShellF)
-> t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedShellF' ShellF -> ShellF
pm t FRequest
cmds K a b
k =
    (ShellF -> ShellF) -> K a b -> F c d -> F (Either a c) (Either b d)
forall a b c d.
(ShellF -> ShellF) -> K a b -> F c d -> F (Either a c) (Either b d)
shellKF' (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(ShellF -> ShellF) -> (ShellF -> ShellF) -> ShellF -> ShellF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShellF -> ShellF
forall xxx. HasMargin xxx => Int -> Customiser xxx
setMargin Int
0)
	     (t FRequest -> K a b -> K a b
forall (t :: * -> *) (f :: * -> * -> *) hi ho.
(Foldable t, FudgetIO f) =>
t FRequest -> f hi ho -> f hi ho
putLows t FRequest
cmds K a b
k)
   
unmappedSimpleShellF :: String -> F i o -> F i o
unmappedSimpleShellF = (ShellF -> ShellF) -> String -> F i o -> F i o
forall i o. (ShellF -> ShellF) -> String -> F i o -> F i o
unmappedSimpleShellF' ShellF -> ShellF
forall a. Customiser a
standard

unmappedSimpleShellF' :: Customiser ShellF -> String -> F i o -> F i o
unmappedSimpleShellF' :: (ShellF -> ShellF) -> String -> F i o -> F i o
unmappedSimpleShellF' ShellF -> ShellF
pm String
name F i o
f = 
   Either o o -> o
forall p. Either p p -> p
stripEither (Either o o -> o)
-> F (Either Bool i) (Either o o) -> F (Either Bool i) o
forall a b e. (a -> b) -> F e a -> F e b
>^=< (ShellF -> ShellF)
-> K Bool o -> F i o -> F (Either Bool i) (Either o o)
forall a b c d.
(ShellF -> ShellF) -> K a b -> F c d -> F (Either a c) (Either b d)
shellKF' ShellF -> ShellF
params K Bool o
forall o. K Bool o
k F i o
f  F (Either Bool i) o -> SP i (Either Bool i) -> F i o
forall c d e. F c d -> SP e c -> F e d
>=^^< SP i (Either Bool i)
forall b. SP b (Either Bool b)
mapraiseSP where
     params :: ShellF -> ShellF
params = Bool -> ShellF -> ShellF
forall xxx. HasVisible xxx => Bool -> Customiser xxx
setVisible Bool
False (ShellF -> ShellF) -> (ShellF -> ShellF) -> ShellF -> ShellF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShellF -> ShellF
pm
     startcmds :: [XCommand]
startcmds = [String -> XCommand
StoreName String
name]
     mapraiseSP :: SP b (Either Bool b)
mapraiseSP = (b -> [Either Bool b]) -> SP b (Either Bool b)
forall t b. (t -> [b]) -> SP t b
concatMapSP ( \b
msg -> [b -> Either Bool b
forall a b. b -> Either a b
Right b
msg, Bool -> Either Bool b
forall a b. a -> Either a b
Left Bool
True])
     k :: K Bool o
k = [XCommand] -> K Bool o -> K Bool o
forall i o. [XCommand] -> K i o -> K i o
xcommandsK [XCommand]
startcmds K Bool o
forall o. K Bool o
mapWindowK

mapWindowK :: K Bool ho
mapWindowK = (Bool -> KEvent Bool -> (Bool, [KCommand ho])) -> Bool -> K Bool ho
forall t hi ho.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK Bool -> KEvent Bool -> (Bool, [KCommand ho])
forall b. Bool -> KEvent Bool -> (Bool, [Message FRequest b])
k1 Bool
False
  where
    k1 :: Bool -> KEvent Bool -> (Bool, [Message FRequest b])
k1 Bool
False  (High Bool
True)                  = (Bool
True,   [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b) -> FRequest -> Message FRequest b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ XCommand
MapRaised])
    k1 Bool
True   (High Bool
False)               = (Bool
False,  [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b) -> FRequest -> Message FRequest b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ XCommand
UnmapWindow])
    k1 Bool
_      (Low (XEvt (UnmapNotify Window
_))) = (Bool
False,  [])
    k1 Bool
_      (Low (XEvt (MapNotify Window
_)))   = (Bool
True,   [])
    k1 Bool
mapped KEvent Bool
_                            = (Bool
mapped, [])

-- Retained for backwards compatibility:
simpleShellF :: String -> [WindowAttributes] -> F c d -> F c d
simpleShellF String
name [WindowAttributes]
wattrs = (ShellF -> ShellF) -> String -> F c d -> F c d
forall i o. (ShellF -> ShellF) -> String -> F i o -> F i o
shellF' ([WindowAttributes] -> ShellF -> ShellF
forall xxx. HasWinAttr xxx => [WindowAttributes] -> Customiser xxx
setWinAttr [WindowAttributes]
wattrs) String
name