0 | module System.Linux.Epoll.Prim
  1 |
  2 | import Data.C.Ptr
  3 | import Data.C.Array
  4 |
  5 | import System.Posix.Signal.Prim
  6 | import System.Posix.Timer.Prim
  7 |
  8 | import public System.Linux.Epoll.Flags
  9 | import public System.Linux.Epoll.Struct
 10 | import public System.Posix.File.Prim
 11 |
 12 | %default total
 13 |
 14 | --------------------------------------------------------------------------------
 15 | -- FFI
 16 | --------------------------------------------------------------------------------
 17 |
 18 | %foreign "C:li_epoll_create, linux-idris"
 19 | prim__epoll_create : Bits32 -> PrimIO CInt
 20 |
 21 | %foreign "C:li_epoll_ctl, linux-idris"
 22 | prim__epoll_ctl : Bits32 -> Bits32 -> Bits32 -> Bits32 -> PrimIO CInt
 23 |
 24 | %foreign "C__collect_safe:li_epoll_wait, linux-idris"
 25 | prim__epoll_wait : Bits32 -> AnyPtr -> Bits32 -> Int32 -> PrimIO CInt
 26 |
 27 | %foreign "C__collect_safe:li_epoll_pwait2, linux-idris"
 28 | prim__epoll_pwait2 : Bits32 -> AnyPtr -> Bits32 -> AnyPtr -> PrimIO CInt
 29 |
 30 | %foreign "C__collect_safe:li_epoll_spwait2, linux-idris"
 31 | prim__epoll_spwait2 : Bits32 -> AnyPtr -> Bits32 -> AnyPtr -> AnyPtr -> PrimIO CInt
 32 |
 33 | --------------------------------------------------------------------------------
 34 | -- API
 35 | --------------------------------------------------------------------------------
 36 |
 37 | ||| Opens a new `epoll` file descriptor.
 38 | export %inline
 39 | epollCreate : EpollFlags -> EPrim Epollfd
 40 | epollCreate (F f) = toVal cast $ prim__epoll_create f
 41 |
 42 | export %inline
 43 | epollCtl :
 44 |      {auto ifd : FileDesc f}
 45 |   -> Epollfd
 46 |   -> EpollOp
 47 |   -> (fd : f)
 48 |   -> PollEvent
 49 |   -> EPrim ()
 50 | epollCtl efd op fd (PE ev) =
 51 |   toUnit $ prim__epoll_ctl (fileDesc efd) (opCode op) (fileDesc fd) ev
 52 |
 53 | export
 54 | epollWait :
 55 |      {n : _}
 56 |   -> Epollfd
 57 |   -> CArrayIO n SEpollEvent
 58 |   -> Int32
 59 |   -> EPrim (k ** CArrayIO k SEpollEvent)
 60 | epollWait efd arr timeout t =
 61 |   let p     := unsafeUnwrap arr
 62 |       r # t := ffi (prim__epoll_wait (fileDesc efd) p (cast n) timeout) t
 63 |    in if r < 0 then E (inject $ fromNeg r) t else R (cast r ** unsafeWrap p) t
 64 |
 65 | export
 66 | epollWaitVals :
 67 |      {n : _}
 68 |   -> Epollfd
 69 |   -> CArrayIO n SEpollEvent
 70 |   -> Int32
 71 |   -> EPrim (List PollPair)
 72 | epollWaitVals efd arr timeout t =
 73 |   let R (k ** arr2) t := epollWait efd arr timeout t | E x t => E x t
 74 |       vs # t          := structs [] arr2 pollPair k t
 75 |    in R vs t
 76 |
 77 | export
 78 | epollPwait2 :
 79 |      {n : _}
 80 |   -> Epollfd
 81 |   -> CArrayIO n SEpollEvent
 82 |   -> Clock Duration
 83 |   -> List Signal
 84 |   -> EPrim (k ** CArrayIO k SEpollEvent)
 85 | epollPwait2 efd arr timeout [] =
 86 |   withTimespec timeout $ \ts,t =>
 87 |     let p     := unsafeUnwrap arr
 88 |         r # t := ffi (prim__epoll_pwait2 (fileDesc efd) p (cast n) (unwrap ts)) t
 89 |      in if r < 0 then E (inject $ fromNeg r) t else R (cast r ** unsafeWrap p) t
 90 | epollPwait2 efd arr timeout sigs =
 91 |   withTimespec timeout $ \ts => withSignals sigs $ \ss,t =>
 92 |     let p     := unsafeUnwrap arr
 93 |         r # t := ffi (prim__epoll_spwait2 (fileDesc efd) p (cast n) (unwrap ts) (unwrap ss)) t
 94 |      in if r < 0 then E (inject $ fromNeg r) t else R (cast r ** unsafeWrap p) t
 95 |
 96 | export
 97 | epollPwait2Vals :
 98 |      {n : _}
 99 |   -> Epollfd
100 |   -> CArrayIO n SEpollEvent
101 |   -> Clock Duration
102 |   -> List Signal
103 |   -> EPrim (List PollPair)
104 | epollPwait2Vals efd arr timeout sigs t =
105 |   let R (k ** arr2) t := epollPwait2 efd arr timeout sigs t | E x t => E x t
106 |       vs # t          := structs [] arr2 pollPair k t
107 |    in R vs t
108 |