module WriteFile where
import HaskellIO(haskellIOF)
--import CompOps((>^=<))
import Cont(contMap)
--import NullF
import DialogueIO hiding (IOError)

writeFileF :: F (String, String) (String, Either IOError ())
writeFileF = (String -> String -> Request)
-> F (String, String) (String, Either IOError ())
forall a t. (a -> t -> Request) -> F (a, t) (a, Either IOError ())
writeFileF' String -> String -> Request
WriteFile
writeXdgFileF :: XdgDirectory -> F (String, String) (String, Either IOError ())
writeXdgFileF = (String -> String -> Request)
-> F (String, String) (String, Either IOError ())
forall a t. (a -> t -> Request) -> F (a, t) (a, Either IOError ())
writeFileF' ((String -> String -> Request)
 -> F (String, String) (String, Either IOError ()))
-> (XdgDirectory -> String -> String -> Request)
-> XdgDirectory
-> F (String, String) (String, Either IOError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> String -> String -> Request
WriteXdgFile

writeFileF' :: (a -> t -> Request) -> F (a, t) (a, Either IOError ())
writeFileF' a -> t -> Request
write = ((a, t)
 -> ((a, Either IOError ()) -> F (a, t) (a, Either IOError ()))
 -> F (a, t) (a, Either IOError ()))
-> F (a, t) (a, Either IOError ())
forall (sp :: * -> * -> *) i o.
StreamProcIO sp =>
(i -> (o -> sp i o) -> sp i o) -> sp i o
contMap (a, t)
-> ((a, Either IOError ()) -> F (a, t) (a, Either IOError ()))
-> F (a, t) (a, Either IOError ())
forall a b. (a, t) -> ((a, Either IOError ()) -> F a b) -> F a b
wr
    where
      wr :: (a, t) -> ((a, Either IOError ()) -> F a b) -> F a b
wr (a
file,t
contents) (a, Either IOError ()) -> F a b
cont =
        Request -> (Response -> F a b) -> F a b
forall a b. Request -> (Response -> F a b) -> F a b
haskellIOF (a -> t -> Request
write a
file t
contents) ((Response -> F a b) -> F a b) -> (Response -> F a b) -> F a b
forall a b. (a -> b) -> a -> b
$ \ Response
resp ->
	(a, Either IOError ()) -> F a b
cont (a
file,Response -> Either IOError ()
post Response
resp)

      post :: Response -> Either IOError ()
post (Failure IOError
e) = IOError -> Either IOError ()
forall a b. a -> Either a b
Left IOError
e
      post Response
Success = () -> Either IOError ()
forall a b. b -> Either a b
Right ()