module NewCache(allcacheF) where
import Command
import FRequest
import Spops
import LoopLow
import Cont
import IsRequest
import qualified Data.Map as OM
allcacheable :: XRequest -> Bool
allcacheable XRequest
xreq =
case XRequest
xreq of
LoadFont FontName
fn -> Bool
True
QueryFont FontId
f -> Bool
True
LoadQueryFont FontName
s -> Bool
True
ListFonts FontName
pat Int
max -> Bool
True
ListFontsWithInfo FontName
pat Int
max -> Bool
True
CreateGC Drawable
d GCId
t GCAttributeList
as -> Bool
True
AllocNamedColor ColormapId
cm FontName
cn -> Bool
True
AllocColor ColormapId
cm RGB
rgb -> Bool
True
CreateFontCursor Int
shape -> Bool
True
ReadBitmapFile FontName
name -> Bool
True
CreateBitmapFromData BitmapData
bdata -> Bool
True
XRequest
_ -> Bool
False
allcacheF :: F i o -> F i o
allcacheF = (XRequest -> Bool) -> F i o -> F i o
forall i o. (XRequest -> Bool) -> F i o -> F i o
cacheF XRequest -> Bool
allcacheable
cacheF :: (XRequest -> Bool) -> F i o -> F i o
cacheF XRequest -> Bool
cacheable F i o
fud = SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
forall i o.
SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
loopThroughLowF (Map XRequest FResponse
-> SP (Either TCommand TEvent) (Either TCommand TEvent)
forall a.
Map XRequest FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
cc Map XRequest FResponse
forall k a. Map k a
OM.empty) F i o
fud where
cc :: Map XRequest FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
cc Map XRequest FResponse
table = SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
same where
same :: SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
same = Cont
(SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
(Either (a, FRequest) (a, FResponse))
forall a b. Cont (SP a b) a
getSP Either (a, FRequest) (a, FResponse)
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
cachehandle
cachehandle :: Either (a, FRequest) (a, FResponse)
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
cachehandle Either (a, FRequest) (a, FResponse)
msg = case Either (a, FRequest) (a, FResponse)
msg of
Left tc :: (a, FRequest)
tc@(a
tag,FRequest
c) ->
case FRequest
c of
XReq XRequest
xreq ->
if XRequest -> Bool
cacheable XRequest
xreq
then case XRequest -> Map XRequest FResponse -> Maybe FResponse
forall k a. Ord k => k -> Map k a -> Maybe a
OM.lookup XRequest
xreq Map XRequest FResponse
table of
Just FResponse
r -> Either (a, FRequest) (a, FResponse)
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((a, FResponse) -> Either (a, FRequest) (a, FResponse)
forall a b. b -> Either a b
Right (a
tag,FResponse
r)) (SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a b. (a -> b) -> a -> b
$
Map XRequest FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
cc Map XRequest FResponse
table
Maybe FResponse
Nothing -> (FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a a.
(FResponse
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
waitresp ((FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> (FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a b. (a -> b) -> a -> b
$ \FResponse
r ->
Map XRequest FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
cc (XRequest
-> FResponse -> Map XRequest FResponse -> Map XRequest FResponse
forall k a. Ord k => k -> a -> Map k a -> Map k a
OM.insert XRequest
xreq FResponse
r Map XRequest FResponse
table)
else (FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a a.
(FResponse
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
waitresp ((FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> (FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a b. (a -> b) -> a -> b
$ \FResponse
r -> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
same
FRequest
_ -> if FRequest -> Bool
isRequest FRequest
c
then (FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a a.
(FResponse
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
waitresp ((FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> (FResponse
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse)))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a b. (a -> b) -> a -> b
$ \FResponse
r -> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
same
else SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
psame
where waitresp :: (FResponse
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
waitresp FResponse
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
c = Either (a, FRequest) (a, FResponse)
-> (Either a (a, FResponse) -> Maybe (a, FResponse))
-> Cont
(SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
(a, FResponse)
forall a b c. a -> (b -> Maybe c) -> Cont (SP b a) c
cmdContSP ((a, FRequest) -> Either (a, FRequest) (a, FResponse)
forall a b. a -> Either a b
Left (a, FRequest)
tc)
(\Either a (a, FResponse)
msg->case Either a (a, FResponse)
msg of Right te :: (a, FResponse)
te@(a
_,FResponse
e) | FResponse -> Bool
isResponse FResponse
e -> (a, FResponse) -> Maybe (a, FResponse)
forall a. a -> Maybe a
Just (a, FResponse)
te
Either a (a, FResponse)
_ -> Maybe (a, FResponse)
forall a. Maybe a
Nothing) Cont
(SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
(a, FResponse)
-> Cont
(SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
(a, FResponse)
forall a b. (a -> b) -> a -> b
$ \tr :: (a, FResponse)
tr@(a
_,FResponse
r) ->
Either (a, FRequest) (a, FResponse)
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((a, FResponse) -> Either (a, FRequest) (a, FResponse)
forall a b. b -> Either a b
Right (a, FResponse)
tr) (SP (Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse)))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
forall a b. (a -> b) -> a -> b
$ FResponse
-> SP
(Either a (a, FResponse)) (Either (a, FRequest) (a, FResponse))
c FResponse
r
Right (a, FResponse)
_ -> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
psame
where
pass :: SP a (Either (a, FRequest) (a, FResponse))
-> SP a (Either (a, FRequest) (a, FResponse))
pass = Either (a, FRequest) (a, FResponse)
-> SP a (Either (a, FRequest) (a, FResponse))
-> SP a (Either (a, FRequest) (a, FResponse))
forall b a. b -> SP a b -> SP a b
putSP Either (a, FRequest) (a, FResponse)
msg
psame :: SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
psame = SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall a.
SP a (Either (a, FRequest) (a, FResponse))
-> SP a (Either (a, FRequest) (a, FResponse))
pass SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
same