module ReadFileF(readFileF,readBinaryFileF,readXdgFileF,readDirF) where
import Fudget() -- synonym KEvent, for hbc
import NullF
import FudgetIO
import IoF(ioF)
import HaskellIO(haskellIO)
import Message(Message(..))
import DialogueIO hiding (IOError)

readFileF :: F String (String, Either IOError String)
readFileF = forall {a} {b}. K a b -> F a b
ioF K String (String, Either IOError String)
readFileK
readBinaryFileF :: F String (String, Either IOError String)
readBinaryFileF = forall {a} {b}. K a b -> F a b
ioF K String (String, Either IOError String)
readBinaryFileK
readXdgFileF :: XdgDirectory -> F String (String, Either IOError String)
readXdgFileF = forall {a} {b}. K a b -> F a b
ioF forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> K String (String, Either IOError String)
readXdgFileK

readFileK :: K String (String, Either IOError String)
readFileK = (String -> Request) -> K String (String, Either IOError String)
readFileK' String -> Request
ReadFile
readBinaryFileK :: K String (String, Either IOError String)
readBinaryFileK = (String -> Request) -> K String (String, Either IOError String)
readFileK' String -> Request
ReadBinaryFile
readXdgFileK :: XdgDirectory -> K String (String, Either IOError String)
readXdgFileK = (String -> Request) -> K String (String, Either IOError String)
readFileK' forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> String -> Request
ReadXdgFile

readFileK' :: (String -> Request) -> K String (String, Either IOError String)
readFileK' String -> Request
req =
  forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \ KEvent String
msg ->
  case KEvent String
msg of
    High String
filename ->
      forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Request -> (Response -> f hi ho) -> f hi ho
haskellIO (String -> Request
req String
filename) forall a b. (a -> b) -> a -> b
$ \ Response
resp ->
      forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (String
filename,case Response
resp of
                          Str String
s -> forall a b. b -> Either a b
Right String
s
		          Failure IOError
err -> forall a b. a -> Either a b
Left IOError
err)
      K String (String, Either IOError String)
readFileK
    KEvent String
_ -> K String (String, Either IOError String)
readFileK

readDirF :: F String (String, Either IOError [String])
readDirF = forall {a} {b}. K a b -> F a b
ioF K String (String, Either IOError [String])
readDirK

readDirK :: K String (String, Either IOError [String])
readDirK =
  forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \ KEvent String
msg ->
  case KEvent String
msg of
    High String
dirname ->
      forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Request -> (Response -> f hi ho) -> f hi ho
haskellIO (String -> Request
ReadDirectory String
dirname) forall a b. (a -> b) -> a -> b
$ \ Response
resp ->
      forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (String
dirname,case Response
resp of
		         StrList [String]
filenames -> forall a b. b -> Either a b
Right [String]
filenames
			 Failure IOError
err -> forall a b. a -> Either a b
Left IOError
err)
      K String (String, Either IOError [String])
readDirK
    KEvent String
_ -> K String (String, Either IOError [String])
readDirK