{-# LANGUAGE CPP #-}
module AutoLayout(autoLayoutF,autoLayoutF',nowait) where
import LayoutRequest(LayoutMessage(..),LayoutResponse(..),LayoutRequest(minsize),LayoutHint,Spacer,Placer(..),Placer2,unS)
import LayoutDoNow
import PathTree hiding (pos)
import Geometry(Rect)
import Fudget
import NullF(getK,putK,putsK)
import Loops(loopThroughRightF)
import UserLayoutF
import FRequest
import Direction
import IoF(ioF)
import CmdLineEnv(argFlag)
import Data.Maybe(isJust)
import HbcUtils(apFst,apSnd)
import Spacers(idS,compS,spacerP)
import AutoPlacer(autoP)
import SizingF
#ifdef __NHC__
import qualified Sizing
#else
import qualified Sizing(Sizing(..))
#endif
import StdIoUtil(echoStderrK)
debugK :: String -> K hi ho -> K hi ho
debugK :: forall hi ho. String -> K hi ho -> K hi ho
debugK =
if Bool
dbg
then \ String
msg -> forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
String -> f hi ho -> f hi ho
echoStderrK (String
"AutoLayout: "forall a. [a] -> [a] -> [a]
++String
msg)
else forall a b. a -> b -> a
const forall a. a -> a
id
where
dbg :: Bool
dbg = String -> Bool -> Bool
argFlag String
"ad" Bool
False
type LayoutTree = PathTree LayoutInfo
mapLT :: (LeafInfo -> LeafInfo)
-> (NodeInfo -> NodeInfo)
-> PathTree LayoutInfo
-> PathTree LayoutInfo
mapLT LeafInfo -> LeafInfo
lf NodeInfo -> NodeInfo
nf = forall {t} {n}. (t -> n) -> PathTree t -> PathTree n
mapPathTree ((LeafInfo -> LeafInfo)
-> (NodeInfo -> NodeInfo) -> LayoutInfo -> LayoutInfo
mapLayoutInfo LeafInfo -> LeafInfo
lf NodeInfo -> NodeInfo
nf)
top0 :: PathTree LayoutInfo
top0 = forall n. n -> PathTree n -> PathTree n -> PathTree n
Node (NodeInfo -> LayoutInfo
NodeInfo (forall a. a -> Maybe a
Just String
"top",PlacerInfo
NoPlacerInfo)) forall n. PathTree n
Tip forall n. PathTree n
Tip
data LayoutInfo
= NodeInfo NodeInfo
| LeafInfo LeafInfo
deriving (Int -> LayoutInfo -> ShowS
[LayoutInfo] -> ShowS
LayoutInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutInfo] -> ShowS
$cshowList :: [LayoutInfo] -> ShowS
show :: LayoutInfo -> String
$cshow :: LayoutInfo -> String
showsPrec :: Int -> LayoutInfo -> ShowS
$cshowsPrec :: Int -> LayoutInfo -> ShowS
Show)
mapLayoutInfo :: (LeafInfo -> LeafInfo)
-> (NodeInfo -> NodeInfo) -> LayoutInfo -> LayoutInfo
mapLayoutInfo LeafInfo -> LeafInfo
lf NodeInfo -> NodeInfo
nf LayoutInfo
n = case LayoutInfo
n of
NodeInfo NodeInfo
n -> NodeInfo -> LayoutInfo
NodeInfo (NodeInfo -> NodeInfo
nf NodeInfo
n)
LeafInfo LeafInfo
l -> LeafInfo -> LayoutInfo
LeafInfo (LeafInfo -> LeafInfo
lf LeafInfo
l)
type LeafInfo = (LayoutRequest,Maybe Rect)
type NodeInfo = ((Maybe LayoutHint), PlacerInfo)
data PlacerInfo =
NoPlacerInfo |
JustSpacer Spacer |
SpacerPlacer Spacer Placer (Maybe Placer2) Spacer
deriving (Int -> PlacerInfo -> ShowS
[PlacerInfo] -> ShowS
PlacerInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlacerInfo] -> ShowS
$cshowList :: [PlacerInfo] -> ShowS
show :: PlacerInfo -> String
$cshow :: PlacerInfo -> String
showsPrec :: Int -> PlacerInfo -> ShowS
$cshowsPrec :: Int -> PlacerInfo -> ShowS
Show)
data PlacementState
= Placed (Rect->Rect)
| Waiting
deriving (Int -> PlacementState -> ShowS
[PlacementState] -> ShowS
PlacementState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlacementState] -> ShowS
$cshowList :: [PlacementState] -> ShowS
show :: PlacementState -> String
$cshow :: PlacementState -> String
showsPrec :: Int -> PlacementState -> ShowS
$cshowsPrec :: Int -> PlacementState -> ShowS
Show)
autoLayoutF :: F a b -> F a b
autoLayoutF = forall a b. Bool -> Sizing -> F a b -> F a b
autoLayoutF' Bool
nowait Sizing
Sizing.Dynamic
nowait :: Bool
nowait = String -> Bool -> Bool
argFlag String
"nowait" Bool
False
autoLayoutF' :: Bool -> Sizing.Sizing -> F a b -> F a b
autoLayoutF' :: forall a b. Bool -> Sizing -> F a b -> F a b
autoLayoutF' Bool
nowait Sizing
sizing F a b
fud =
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF
(forall a b.
F a b -> F (Either (Path, Rect) a) (Either (Path, LayoutMessage) b)
userLayoutF (forall {hi} {ho}. F hi ho -> F hi ho
layoutDoNow F a b
fud))
( (forall {i} {o}. Sizing -> F i o -> F i o
sizingF Sizing
sizing (forall {a} {b}. K a b -> F a b
ioF (PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
autoLayoutMgrK0 PlacementState
state0 PathTree LayoutInfo
top0))))
where
state0 :: PlacementState
state0 = if Bool
nowait then (Rect -> Rect) -> PlacementState
Placed forall a. a -> a
id else PlacementState
Waiting
autoLayoutMgrK0 :: PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
autoLayoutMgrK0 PlacementState
pstate PathTree LayoutInfo
ltree =
forall hi ho. String -> K hi ho -> K hi ho
debugK String
"autoLayoutMgrK" forall a b. (a -> b) -> a -> b
$
PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
autoLayoutMgrK PlacementState
pstate PathTree LayoutInfo
ltree
autoLayoutMgrK :: PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
autoLayoutMgrK PlacementState
pstate PathTree LayoutInfo
ltree =
forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \ KEvent (Path, LayoutMessage)
msg ->
case KEvent (Path, LayoutMessage)
msg of
High (Path
path,LayoutMessage
layoutmsg) ->
case LayoutMessage
layoutmsg of
LayoutMessage
LayoutDoNow ->
forall hi ho. String -> K hi ho -> K hi ho
debugK String
"LayoutDoNow" forall a b. (a -> b) -> a -> b
$
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show PathTree LayoutInfo
ltree) forall a b. (a -> b) -> a -> b
$
PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newPlace PathTree LayoutInfo
ltree
LayoutRequest LayoutRequest
req ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show Path
path forall a. [a] -> [a] -> [a]
++ String
" Layout "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (LayoutRequest -> Size
minsize LayoutRequest
req)) forall a b. (a -> b) -> a -> b
$
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show PathTree LayoutInfo
ltree') forall a b. (a -> b) -> a -> b
$
PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
changePlacement PathTree LayoutInfo
ltree'
where ltree' :: PathTree LayoutInfo
ltree' = Path -> LayoutRequest -> PathTree LayoutInfo -> PathTree LayoutInfo
updateLeaf Path
path LayoutRequest
req PathTree LayoutInfo
ltree''
ltree'' :: PathTree LayoutInfo
ltree'' = if forall {n}. Show n => PathTree n -> Path -> Bool
newBox PathTree LayoutInfo
ltree Path
path
then PathTree LayoutInfo -> PathTree LayoutInfo
forgetPlaces PathTree LayoutInfo
ltree
else PathTree LayoutInfo
ltree
LayoutHint String
hint ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show Path
path forall a. [a] -> [a] -> [a]
++ String
" LayoutHint "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
hint) forall a b. (a -> b) -> a -> b
$
(NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
updnode (forall {a} {a}. a -> (a, PlacerInfo) -> (Maybe a, PlacerInfo)
insertHint String
hint)
LayoutPlacer Placer
placer ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show Path
path forall a. [a] -> [a] -> [a]
++ String
" LayoutPlacer ...") forall a b. (a -> b) -> a -> b
$
(NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
updnode (forall {a} {a}. Placer -> (a, PlacerInfo) -> (Maybe a, PlacerInfo)
insertPlacer Placer
placer)
LayoutSpacer Spacer
spacer ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show Path
path forall a. [a] -> [a] -> [a]
++ String
" LayoutSpacer ...") forall a b. (a -> b) -> a -> b
$
(NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
updnode (forall {a}. Spacer -> (a, PlacerInfo) -> (a, PlacerInfo)
insertSpacer Spacer
spacer)
LayoutReplaceSpacer Spacer
spacer ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show Path
path forall a. [a] -> [a] -> [a]
++ String
" LayoutReplaceSpacer ...") forall a b. (a -> b) -> a -> b
$
(NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
replnode (forall {a}. Spacer -> (a, PlacerInfo) -> (a, PlacerInfo)
replaceSpacer Spacer
spacer)
LayoutReplacePlacer Placer
placer ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show Path
path forall a. [a] -> [a] -> [a]
++ String
" LayoutReplacePlacer ...") forall a b. (a -> b) -> a -> b
$
(NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
replnode (forall {a}. Placer -> (a, PlacerInfo) -> (a, PlacerInfo)
replacePlacer Placer
placer)
LayoutMessage
LayoutDestroy ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (forall a. Show a => a -> String
show (Path
path,PathTree LayoutInfo
ltree) forall a. [a] -> [a] -> [a]
++ String
" LayoutDestroy") forall a b. (a -> b) -> a -> b
$
if forall {n}. Show n => PathTree n -> Path -> Bool
newBox PathTree LayoutInfo
ltree Path
path then forall hi ho. String -> K hi ho -> K hi ho
debugK (String
"not in tree") K (Path, LayoutMessage) (Path, Rect)
same else
PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
changePlacement (PathTree LayoutInfo -> PathTree LayoutInfo
forgetPlaces (Path -> PathTree LayoutInfo -> PathTree LayoutInfo
pruneLTree Path
path PathTree LayoutInfo
ltree))
LayoutMakeVisible Rect
_ (Maybe Alignment, Maybe Alignment)
_ -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd LayoutMessage
layoutmsg)) forall a b. (a -> b) -> a -> b
$ K (Path, LayoutMessage) (Path, Rect)
same
LayoutScrollStep Int
_ -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd LayoutMessage
layoutmsg)) forall a b. (a -> b) -> a -> b
$ K (Path, LayoutMessage) (Path, Rect)
same
LayoutMessage
_ -> K (Path, LayoutMessage) (Path, Rect)
same
where updnode :: (NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
updnode NodeInfo -> NodeInfo
u = PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newTree (Path
-> (NodeInfo -> NodeInfo)
-> PathTree LayoutInfo
-> PathTree LayoutInfo
updateLNode Path
path NodeInfo -> NodeInfo
u PathTree LayoutInfo
ltree)
replnode :: (NodeInfo -> NodeInfo) -> K (Path, LayoutMessage) (Path, Rect)
replnode NodeInfo -> NodeInfo
u = PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
changePlacement (PathTree LayoutInfo -> PathTree LayoutInfo
forgetPlaces (Path
-> (NodeInfo -> NodeInfo)
-> PathTree LayoutInfo
-> PathTree LayoutInfo
updateLNode Path
path NodeInfo -> NodeInfo
u PathTree LayoutInfo
ltree))
Low (LEvt (LayoutPlace Rect
rect)) ->
forall hi ho. String -> K hi ho -> K hi ho
debugK (String
"splitting 1 Place into "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, Rect)]
msgs)) forall a b. (a -> b) -> a -> b
$
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Message a b
High [(Path, Rect)]
msgs) forall a b. (a -> b) -> a -> b
$
PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newTree PathTree LayoutInfo
ltree'
where (PathTree LayoutInfo
ltree',[(Path, Rect)]
msgs) = Rect
-> PathTree LayoutInfo -> (PathTree LayoutInfo, [(Path, Rect)])
doLayout (Rect -> Rect
s2 Rect
rect) PathTree LayoutInfo
ltree
s2 :: Rect -> Rect
s2 = case PlacementState
pstate of
Placed Rect -> Rect
s2 -> Rect -> Rect
s2
PlacementState
_ -> forall a. a -> a
id
Low FResponse
_ -> forall hi ho. String -> K hi ho -> K hi ho
debugK String
"Ignored low level msg" K (Path, LayoutMessage) (Path, Rect)
same
where
same :: K (Path, LayoutMessage) (Path, Rect)
same = PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
autoLayoutMgrK PlacementState
pstate PathTree LayoutInfo
ltree
newTree :: PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newTree PathTree LayoutInfo
t' = PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newState PlacementState
pstate PathTree LayoutInfo
t'
newState :: PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newState PlacementState
p' PathTree LayoutInfo
t' = PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
autoLayoutMgrK PlacementState
p' PathTree LayoutInfo
t'
changePlacement :: PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
changePlacement PathTree LayoutInfo
ltree' =
case PlacementState
pstate of
Placed Rect -> Rect
_ -> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newPlace PathTree LayoutInfo
ltree'
PlacementState
Waiting -> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newTree PathTree LayoutInfo
ltree'
newPlace :: PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newPlace PathTree LayoutInfo
ltree =
let ltree' :: PathTree LayoutInfo
ltree' = PathTree LayoutInfo -> PathTree LayoutInfo
chooseLayout PathTree LayoutInfo
ltree
in case PathTree LayoutInfo -> ([Spacer2], PathTree LayoutInfo)
collectReqs PathTree LayoutInfo
ltree' of
([],PathTree LayoutInfo
_) -> forall hi ho. String -> K hi ho -> K hi ho
debugK String
"newPlace without any requests in ltree" K (Path, LayoutMessage) (Path, Rect)
same
((LayoutRequest
req,Rect -> Rect
s2):[Spacer2]
_,PathTree LayoutInfo
ltree2) ->
forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd LayoutRequest
req)) forall a b. (a -> b) -> a -> b
$
PlacementState
-> PathTree LayoutInfo -> K (Path, LayoutMessage) (Path, Rect)
newState ((Rect -> Rect) -> PlacementState
Placed Rect -> Rect
s2) PathTree LayoutInfo
ltree2
updateLNode :: Path
-> (NodeInfo -> NodeInfo)
-> PathTree LayoutInfo
-> PathTree LayoutInfo
updateLNode Path
path NodeInfo -> NodeInfo
i PathTree LayoutInfo
t = forall {t}.
(t -> t) -> t -> PathTree t -> Path -> (t -> t) -> PathTree t
updateNode forall a. a -> a
id LayoutInfo
emptyNode PathTree LayoutInfo
t Path
path forall a b. (a -> b) -> a -> b
$
\(NodeInfo NodeInfo
ni) -> NodeInfo -> LayoutInfo
NodeInfo (NodeInfo -> NodeInfo
i NodeInfo
ni)
insertHint :: a -> (a, PlacerInfo) -> (Maybe a, PlacerInfo)
insertHint a
hint (a
_,PlacerInfo
pi) = (case PlacerInfo
pi of
SpacerPlacer Spacer
_ Placer
_ Maybe Placer2
_ Spacer
_ -> forall a. Maybe a
Nothing
PlacerInfo
_ -> forall a. a -> Maybe a
Just a
hint,PlacerInfo
pi)
insertPlacer :: Placer -> (a, PlacerInfo) -> (Maybe a, PlacerInfo)
insertPlacer Placer
placer (a
hint,PlacerInfo
pi) = (forall a. Maybe a
Nothing,case PlacerInfo
pi of
PlacerInfo
NoPlacerInfo -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
idS Placer
placer forall a. Maybe a
Nothing Spacer
idS
JustSpacer Spacer
s -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s Placer
placer forall a. Maybe a
Nothing Spacer
idS
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
_ Spacer
s2 -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer (Spacer
s1 Spacer -> Spacer -> Spacer
`compS` Spacer
s2) (Placer
p Placer -> Placer -> Placer
`compP` Placer
placer)
forall a. Maybe a
Nothing Spacer
idS)
where compP :: Placer -> Placer -> Placer
compP :: Placer -> Placer -> Placer
compP (P Placer1
p1) (P Placer1
p2) = Placer1 -> Placer
P forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
reqs ->
let (LayoutRequest
req1,Rect -> [Rect]
p1r) = Placer1
p1 [LayoutRequest
req2]
(LayoutRequest
req2,Rect -> [Rect]
p2r) = Placer1
p2 [LayoutRequest]
reqs
in (LayoutRequest
req1,Rect -> [Rect]
p2rforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> a
headforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> [Rect]
p1r)
insertSpacer :: Spacer -> (a, PlacerInfo) -> (a, PlacerInfo)
insertSpacer Spacer
spacer (a
hint,PlacerInfo
pi) = (a
hint,case PlacerInfo
pi of
PlacerInfo
NoPlacerInfo -> Spacer -> PlacerInfo
JustSpacer Spacer
spacer
JustSpacer Spacer
s -> Spacer -> PlacerInfo
JustSpacer (Spacer
s Spacer -> Spacer -> Spacer
`compS` Spacer
spacer)
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
p2 Spacer
s2 -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
p2 (Spacer
s2 Spacer -> Spacer -> Spacer
`compS` Spacer
spacer))
replaceSpacer :: Spacer -> (a, PlacerInfo) -> (a, PlacerInfo)
replaceSpacer Spacer
spacer (a
hint,PlacerInfo
pi) = (a
hint,PlacerInfo
pi')
where
pi' :: PlacerInfo
pi' = case PlacerInfo
pi of
PlacerInfo
NoPlacerInfo -> Spacer -> PlacerInfo
JustSpacer Spacer
spacer
JustSpacer Spacer
s -> Spacer -> PlacerInfo
JustSpacer Spacer
spacer
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
p2 Spacer
s2 -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
spacer Placer
p Maybe Placer2
p2 Spacer
s2
replacePlacer :: Placer -> (a, PlacerInfo) -> (a, PlacerInfo)
replacePlacer Placer
placer (a
hint,PlacerInfo
pi) = (a
hint,PlacerInfo
pi')
where
pi' :: PlacerInfo
pi' = case PlacerInfo
pi of
PlacerInfo
NoPlacerInfo -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
idS Placer
placer forall a. Maybe a
Nothing Spacer
idS
JustSpacer Spacer
s -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s Placer
placer forall a. Maybe a
Nothing Spacer
idS
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
p2 Spacer
s2 -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s1 Placer
placer forall a. Maybe a
Nothing Spacer
s2
updateLeaf :: Path -> LayoutRequest -> PathTree LayoutInfo -> PathTree LayoutInfo
updateLeaf Path
path LayoutRequest
l PathTree LayoutInfo
t =
forall {t}.
(t -> t) -> t -> PathTree t -> Path -> (t -> t) -> PathTree t
updateNode LayoutInfo -> LayoutInfo
invalid LayoutInfo
emptyNode PathTree LayoutInfo
t Path
path (forall a b. a -> b -> a
const (LeafInfo -> LayoutInfo
LeafInfo (LayoutRequest
l,forall a. Maybe a
Nothing)))
pruneLTree :: Path -> PathTree LayoutInfo -> PathTree LayoutInfo
pruneLTree Path
path PathTree LayoutInfo
t = forall {t}. (t -> t) -> t -> PathTree t -> Path -> PathTree t
pruneTree LayoutInfo -> LayoutInfo
invalid LayoutInfo
emptyNode PathTree LayoutInfo
t Path
path
forgetPlaces :: PathTree LayoutInfo -> PathTree LayoutInfo
forgetPlaces = (LeafInfo -> LeafInfo)
-> (NodeInfo -> NodeInfo)
-> PathTree LayoutInfo
-> PathTree LayoutInfo
mapLT (forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
apSnd (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)) forall a. a -> a
id
newBox :: PathTree n -> Path -> Bool
newBox PathTree n
x = forall {n} {t}.
Show n =>
(PathTree n -> t) -> t -> PathTree n -> Path -> t
subTree (forall a b. a -> b -> a
const Bool
False) Bool
True PathTree n
x
invalid :: LayoutInfo -> LayoutInfo
invalid (NodeInfo NodeInfo
i) = NodeInfo -> LayoutInfo
NodeInfo (forall {a}. (a, PlacerInfo) -> (a, PlacerInfo)
invalid' NodeInfo
i)
where
invalid' :: (a, PlacerInfo) -> (a, PlacerInfo)
invalid' (a
hi,SpacerPlacer Spacer
s Placer
p Maybe Placer2
p2 Spacer
s2) = (a
hi,Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s Placer
p forall a. Maybe a
Nothing Spacer
s2)
invalid' (a, PlacerInfo)
ni = (a, PlacerInfo)
ni
emptyNode :: LayoutInfo
emptyNode = NodeInfo -> LayoutInfo
NodeInfo (forall a. Maybe a
Nothing,PlacerInfo
NoPlacerInfo)
hasPlacer :: (Maybe a, PlacerInfo) -> Bool
hasPlacer (Maybe a
Nothing,SpacerPlacer Spacer
_ Placer
_ Maybe Placer2
_ Spacer
_) = Bool
True
hasPlacer (Maybe a, PlacerInfo)
_ = Bool
False
chooseLayout :: PathTree LayoutInfo -> PathTree LayoutInfo
chooseLayout = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {i} {s}.
(i -> [s] -> LeafInfo -> (i, s, LeafInfo))
-> (i -> [s] -> NodeInfo -> (i, s, NodeInfo))
-> i
-> PathTree LayoutInfo
-> ([s], PathTree LayoutInfo)
attrMapLT forall {a} {p} {c}. a -> p -> c -> (a, (), c)
lf forall {p} {a}.
Bool
-> p -> (Maybe a, PlacerInfo) -> (Bool, (), (Maybe a, PlacerInfo))
nf Bool
False where
lf :: a -> p -> c -> (a, (), c)
lf a
strip p
_ c
i = (a
strip,(),c
i)
nf :: Bool
-> p -> (Maybe a, PlacerInfo) -> (Bool, (), (Maybe a, PlacerInfo))
nf Bool
strip p
_ (Maybe a, PlacerInfo)
n = (Bool
strip',(),(Maybe a, PlacerInfo)
n') where
strip' :: Bool
strip' = case (Maybe a, PlacerInfo)
n of
(Maybe a
Nothing,SpacerPlacer Spacer
_ Placer
_ Maybe Placer2
_ Spacer
_) -> Bool
True
(Maybe a, PlacerInfo)
_ -> Bool
strip
n' :: (Maybe a, PlacerInfo)
n' = if Bool
strip then (Maybe a, PlacerInfo)
n else forall {a}. (Maybe a, PlacerInfo) -> (Maybe a, PlacerInfo)
choosePlacer (Maybe a, PlacerInfo)
n
choosePlacer :: (Maybe a, PlacerInfo) -> (Maybe a, PlacerInfo)
choosePlacer (Maybe a, PlacerInfo)
i = case (Maybe a, PlacerInfo)
i of
(hi :: Maybe a
hi@(Just a
_),PlacerInfo
pi) -> (Maybe a
hi,case PlacerInfo
pi of
PlacerInfo
NoPlacerInfo -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
idS Placer
autoP forall a. Maybe a
Nothing Spacer
idS
JustSpacer Spacer
s -> Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s Placer
autoP forall a. Maybe a
Nothing Spacer
idS
PlacerInfo
p -> PlacerInfo
p)
(Maybe a, PlacerInfo)
i -> (Maybe a, PlacerInfo)
i
attrMapLT :: (i -> [s] -> LeafInfo -> (i, s, LeafInfo))
-> (i -> [s] -> NodeInfo -> (i, s, NodeInfo))
-> i
-> PathTree LayoutInfo
-> ([s], PathTree LayoutInfo)
attrMapLT i -> [s] -> LeafInfo -> (i, s, LeafInfo)
lf i -> [s] -> NodeInfo -> (i, s, NodeInfo)
nf = forall i s a b.
(i -> [s] -> a -> (i, s, b))
-> i -> PathTree a -> ([s], PathTree b)
attrMapPathTree i -> [s] -> LayoutInfo -> (i, s, LayoutInfo)
f where
f :: i -> [s] -> LayoutInfo -> (i, s, LayoutInfo)
f i
i [s]
s LayoutInfo
a = case LayoutInfo
a of
LeafInfo LeafInfo
li -> forall {t} {c} {a} {b}. (t -> c) -> (a, b, t) -> (a, b, c)
a3 LeafInfo -> LayoutInfo
LeafInfo forall a b. (a -> b) -> a -> b
$ i -> [s] -> LeafInfo -> (i, s, LeafInfo)
lf i
i [s]
s LeafInfo
li
NodeInfo NodeInfo
ni -> forall {t} {c} {a} {b}. (t -> c) -> (a, b, t) -> (a, b, c)
a3 NodeInfo -> LayoutInfo
NodeInfo forall a b. (a -> b) -> a -> b
$ i -> [s] -> NodeInfo -> (i, s, NodeInfo)
nf i
i [s]
s NodeInfo
ni
a3 :: (t -> c) -> (a, b, t) -> (a, b, c)
a3 t -> c
c (a
i,b
s,t
b) = (a
i,b
s,t -> c
c t
b)
collectReqs :: PathTree LayoutInfo -> ([Spacer2], PathTree LayoutInfo)
collectReqs = forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
apFst (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {b}. [b -> b] -> b -> b
compose []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {i} {s}.
(i -> [s] -> LeafInfo -> (i, s, LeafInfo))
-> (i -> [s] -> NodeInfo -> (i, s, NodeInfo))
-> i
-> PathTree LayoutInfo
-> ([s], PathTree LayoutInfo)
attrMapLT forall {p} {b}.
Spacer
-> p
-> (LayoutRequest, b)
-> (Spacer, [Spacer2] -> [Spacer2], (LayoutRequest, b))
lf forall {a}.
Spacer
-> [[Spacer2] -> [Spacer2]]
-> (Maybe a, PlacerInfo)
-> (Spacer, [Spacer2] -> [Spacer2], (Maybe a, PlacerInfo))
nf Spacer
idS where
lf :: Spacer
-> p
-> (LayoutRequest, b)
-> (Spacer, [Spacer2] -> [Spacer2], (LayoutRequest, b))
lf Spacer
s p
_ i :: (LayoutRequest, b)
i@(LayoutRequest
req,b
oplace) = (Spacer
s,[Spacer2] -> [Spacer2]
reqf,(LayoutRequest, b)
i) where
reqf :: [Spacer2] -> [Spacer2]
reqf = (Spacer -> Spacer1
unS Spacer
s LayoutRequest
lrforall a. a -> [a] -> [a]
:)
lr :: LayoutRequest
lr = case b
oplace of
b
_ ->
LayoutRequest
req
nf :: Spacer
-> [[Spacer2] -> [Spacer2]]
-> (Maybe a, PlacerInfo)
-> (Spacer, [Spacer2] -> [Spacer2], (Maybe a, PlacerInfo))
nf Spacer
s [[Spacer2] -> [Spacer2]]
reqfs n :: (Maybe a, PlacerInfo)
n@(Maybe a
hi,PlacerInfo
pi) = case PlacerInfo
pi of
PlacerInfo
NoPlacerInfo -> (Spacer
s,[Spacer2] -> [Spacer2]
reqf,(Maybe a, PlacerInfo)
n)
JustSpacer Spacer
s1 ->
(Spacer
s Spacer -> Spacer -> Spacer
`compS` Spacer
s1,[Spacer2] -> [Spacer2]
reqf,(Maybe a, PlacerInfo)
n)
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
orp2 Spacer
s2 ->
(Spacer
inherS,[Spacer2] -> [Spacer2]
syntreq,(Maybe a, PlacerInfo)
n') where
rp2 :: Placer2
rp2@(LayoutRequest
req2,Rect -> [Rect]
p2) = Placer
compp forall {a}.
Placer
-> [(LayoutRequest, Rect -> a)] -> (LayoutRequest, Rect -> [a])
`spacer2P` [Spacer2]
reqfl
reqfl :: [Spacer2]
reqfl = [Spacer2] -> [Spacer2]
reqf []
compp :: Placer
compp = if Bool
hashint then Placer
p else Spacer
sl Spacer -> Placer -> Placer
`spacerP` Placer
p
inherS :: Spacer
inherS = if Bool
hashint then Spacer
sl Spacer -> Spacer -> Spacer
`compS` Spacer
s2 else Spacer
s2
syntreq :: [Spacer2] -> [Spacer2]
syntreq = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Spacer2]
reqfl then forall a. a -> a
id else (Spacer -> Spacer1
unS Spacer
idS LayoutRequest
req2forall a. a -> [a] -> [a]
:)
sl :: Spacer
sl = Spacer
s Spacer -> Spacer -> Spacer
`compS` Spacer
s1
hashint :: Bool
hashint = forall a. Maybe a -> Bool
isJust Maybe a
hi
orp2' :: Maybe Placer2
orp2' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Spacer2]
reqfl then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Placer2
rp2
n' :: (Maybe a, PlacerInfo)
n' = (Maybe a
hi,Spacer -> Placer -> Maybe Placer2 -> Spacer -> PlacerInfo
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
orp2' Spacer
s2)
where reqf :: [Spacer2] -> [Spacer2]
reqf = forall {b}. [b -> b] -> b -> b
compose [[Spacer2] -> [Spacer2]]
reqfs
compose :: [b -> b] -> b -> b
compose = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
doLayout :: Rect
-> PathTree LayoutInfo -> (PathTree LayoutInfo, [(Path, Rect)])
doLayout Rect
rect PathTree LayoutInfo
tree = forall {p} {a} {a} {a} {b}.
(p -> [a] -> (a, (a, b))) -> p -> (a, b)
runIO (PathTree LayoutInfo
-> Path
-> [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doLayoutIO PathTree LayoutInfo
tree []) [Rect
rect]
spacer2P :: Placer
-> [(LayoutRequest, Rect -> a)] -> (LayoutRequest, Rect -> [a])
spacer2P (P Placer1
p) [(LayoutRequest, Rect -> a)]
reqfs = (LayoutRequest
req,[Rect] -> [a]
s2fforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> [Rect]
p2) where
([LayoutRequest]
reqs,[Rect -> a]
s2s) = forall a b. [(a, b)] -> ([a], [b])
unzip [(LayoutRequest, Rect -> a)]
reqfs
s2f :: [Rect] -> [a]
s2f [Rect]
rs = [Rect -> a
s2 Rect
r | (Rect -> a
s2,Rect
r) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Rect -> a]
s2s [Rect]
rs]
(LayoutRequest
req,Rect -> [Rect]
p2) = Placer1
p [LayoutRequest]
reqs
doLayoutIO :: PathTree LayoutInfo
-> Path
-> [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doLayoutIO PathTree LayoutInfo
t Path
path =
case PathTree LayoutInfo
t of
PathTree LayoutInfo
Tip -> forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO PathTree LayoutInfo
t
Node (LeafInfo (LayoutRequest
l,Maybe Rect
maybeOldRect)) PathTree LayoutInfo
_ PathTree LayoutInfo
_ ->
forall {a} {b}. [a] -> b -> (a, ([a], b))
getIO forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`bindIO` \ Rect
r ->
forall {a} {a}. a -> a -> [a] -> ((), (a, [a]))
putIO (forall a. [a] -> [a]
reverse Path
path,Rect
r) forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`thenIO`
forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO (forall n. n -> PathTree n -> PathTree n -> PathTree n
Node (LeafInfo -> LayoutInfo
LeafInfo (LayoutRequest
l,forall a. a -> Maybe a
Just Rect
r)) forall n. PathTree n
Tip forall n. PathTree n
Tip)
Dynamic DynTree (PathTree LayoutInfo)
dt -> forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO forall n. DynTree (PathTree n) -> PathTree n
Dynamic forall {p} {t} {t} {a} {t} {b} {t} {a}.
(p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap` DynTree (PathTree LayoutInfo)
-> Path
-> Int
-> Int
-> [Rect]
-> [(Path, Rect)]
-> (DynTree (PathTree LayoutInfo), ([Rect], [(Path, Rect)]))
dynDoLayoutIO DynTree (PathTree LayoutInfo)
dt Path
path Int
0 Int
1
Node ni :: LayoutInfo
ni@(NodeInfo (Maybe String
_,PlacerInfo
pi)) PathTree LayoutInfo
lt PathTree LayoutInfo
rt ->
case PlacerInfo
pi of
SpacerPlacer Spacer
s1 Placer
p Maybe Placer2
orp2 Spacer
s2 ->
case Maybe Placer2
orp2 of
Just (LayoutRequest
req,Rect -> [Rect]
placer2) ->
forall {a} {b}. [a] -> b -> (a, ([a], b))
getIO forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`bindIO` \ Rect
r ->
forall {a} {b}. [a] -> [a] -> b -> ((), ([a], b))
ungetIO (Rect -> [Rect]
placer2 Rect
r) forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`thenIO`
[Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doBranches
Maybe Placer2
Nothing -> forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO PathTree LayoutInfo
t
PlacerInfo
_ -> [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doBranches
where
doBranches :: [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doBranches =
forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO (forall n. n -> PathTree n -> PathTree n -> PathTree n
Node LayoutInfo
ni) forall {p} {t} {t} {a} {t} {b} {t} {a}.
(p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap` PathTree LayoutInfo
-> Path
-> [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doLayoutIO PathTree LayoutInfo
lt (Direction
Lforall a. a -> [a] -> [a]
:Path
path)
forall {p} {t} {t} {a} {t} {b} {t} {a}.
(p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap` PathTree LayoutInfo
-> Path
-> [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doLayoutIO PathTree LayoutInfo
rt (Direction
Rforall a. a -> [a] -> [a]
:Path
path)
dynDoLayoutIO :: DynTree (PathTree LayoutInfo)
-> Path
-> Int
-> Int
-> [Rect]
-> [(Path, Rect)]
-> (DynTree (PathTree LayoutInfo), ([Rect], [(Path, Rect)]))
dynDoLayoutIO DynTree (PathTree LayoutInfo)
dt Path
path Int
n Int
i =
case DynTree (PathTree LayoutInfo)
dt of
DynTree (PathTree LayoutInfo)
DynTip -> forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO DynTree (PathTree LayoutInfo)
dt
DynNode PathTree LayoutInfo
t DynTree (PathTree LayoutInfo)
lt DynTree (PathTree LayoutInfo)
rt ->
forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode forall {p} {t} {t} {a} {t} {b} {t} {a}.
(p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap`
PathTree LayoutInfo
-> Path
-> [Rect]
-> [(Path, Rect)]
-> (PathTree LayoutInfo, ([Rect], [(Path, Rect)]))
doLayoutIO PathTree LayoutInfo
t (Int -> Direction
Dno (Int -> Int
unpos Int
n)forall a. a -> [a] -> [a]
:Path
path) forall {p} {t} {t} {a} {t} {b} {t} {a}.
(p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap`
DynTree (PathTree LayoutInfo)
-> Path
-> Int
-> Int
-> [Rect]
-> [(Path, Rect)]
-> (DynTree (PathTree LayoutInfo), ([Rect], [(Path, Rect)]))
dynDoLayoutIO DynTree (PathTree LayoutInfo)
lt Path
path Int
n (Int
2forall a. Num a => a -> a -> a
*Int
i) forall {p} {t} {t} {a} {t} {b} {t} {a}.
(p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap`
DynTree (PathTree LayoutInfo)
-> Path
-> Int
-> Int
-> [Rect]
-> [(Path, Rect)]
-> (DynTree (PathTree LayoutInfo), ([Rect], [(Path, Rect)]))
dynDoLayoutIO DynTree (PathTree LayoutInfo)
rt Path
path (Int
nforall a. Num a => a -> a -> a
+Int
i) (Int
2forall a. Num a => a -> a -> a
*Int
i)
type IO' a i o = i -> o -> (a,(i,o))
runIO :: (p -> [a] -> (a, (a, b))) -> p -> (a, b)
runIO p -> [a] -> (a, (a, b))
io p
i =
let (a
a,(a
_,b
o)) = p -> [a] -> (a, (a, b))
io p
i []
in (a
a,b
o)
returnIO :: a -> a -> b -> (a, (a, b))
returnIO a
a a
i b
o = (a
a,(a
i,b
o))
putIO :: a -> a -> [a] -> ((), (a, [a]))
putIO a
o1 a
is [a]
os = ((),(a
is,a
o1forall a. a -> [a] -> [a]
:[a]
os))
getIO :: [a] -> b -> (a, ([a], b))
getIO (a
i:[a]
is) b
os = (a
i, ([a]
is,b
os))
ungetIO :: [a] -> [a] -> b -> ((), ([a], b))
ungetIO [a]
is' [a]
is b
os = ((),([a]
is'forall a. [a] -> [a] -> [a]
++[a]
is,b
os))
bindIO :: (p -> t -> (t, (t, b)))
-> (t -> t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
bindIO p -> t -> (t, (t, b))
io1 t -> t -> p -> (a, (a, t))
xio2 p
i0 p
o0 =
let (t
x,(t
i1,b
o2)) = p -> t -> (t, (t, b))
io1 p
i0 t
o1
(a
y,(a
i2,t
o1)) = t -> t -> p -> (a, (a, t))
xio2 t
x t
i1 p
o0
in (a
y,(a
i2,b
o2))
thenIO :: (p -> t -> (t, (t, b)))
-> (t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
thenIO p -> t -> (t, (t, b))
f1 t -> p -> (a, (a, t))
f2 = p -> t -> (t, (t, b))
f1 forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`bindIO` forall a b. a -> b -> a
const t -> p -> (a, (a, t))
f2
p -> t -> (t -> a, (t, b))
fIO ap :: (p -> t -> (t -> a, (t, b)))
-> (t -> t -> (t, (a, t))) -> p -> t -> (a, (a, b))
`ap` t -> t -> (t, (a, t))
xIO = p -> t -> (t -> a, (t, b))
fIO forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`bindIO` \ t -> a
f ->
t -> t -> (t, (a, t))
xIO forall {p} {t} {t} {t} {b} {p} {a} {a}.
(p -> t -> (t, (t, b)))
-> (t -> t -> p -> (a, (a, t))) -> p -> p -> (a, (a, b))
`bindIO` \ t
x ->
forall {a} {a} {b}. a -> a -> b -> (a, (a, b))
returnIO (t -> a
f t
x)