Inotify.icl 3.94 KB
Newer Older
Camil Staps's avatar
Camil Staps committed
1 2 3 4 5 6 7
implementation module Inotify

import StdArray
import StdBool
import StdFunc
import StdInt
import StdList
8
from StdOverloaded import class zero(zero)
Camil Staps's avatar
Camil Staps committed
9 10
import StdString

11 12 13 14 15
import Data.Either
import Data.List
import Data.Maybe
import System._Pointer
import System._Posix
Camil Staps's avatar
Camil Staps committed
16 17 18

import code from "inotify_c.o"

19 20 21 22 23
:: *Inotify st =
	{ fd      :: !Int
	, watches :: ![(INWatch, INCallback st)]
	, state   :: !st
	}
Camil Staps's avatar
Camil Staps committed
24 25 26 27 28 29 30 31

:: INWatch :== Int

(|-) infixl 6 :: (INMask INMask -> INMask)
(|-) = bitor

inotify_init :: st -> Maybe *(Inotify st)
inotify_init st
32 33 34 35 36
	# (fd,_) = c_init 0
	| fd < 0 = Nothing
	# (i,_)  = fcntlArg fd 00004000 0 37 // IN_NONBLOCK
	| i <> i = Nothing
	= Just {fd=fd, watches=[], state=st}
Camil Staps's avatar
Camil Staps committed
37
where
38
	c_init :: !Int -> (!Int, !Int)
Camil Staps's avatar
Camil Staps committed
39
	c_init i = code {
40
		ccall inotify_init ":I:I"
Camil Staps's avatar
Camil Staps committed
41 42 43 44 45
	}

inotify_close :: *(Inotify st) -> st
inotify_close {fd,state} = c_close fd state
where
46
	c_close :: !Int !st -> st
Camil Staps's avatar
Camil Staps committed
47 48 49 50
	c_close fd st = code {
		ccall close "I:V:A"
	}

51 52
inotify_add_watch :: (INCallback st) !INMask !String !*(Inotify st)
                  -> *(!Either Int INWatch, !*Inotify st)
Camil Staps's avatar
Camil Staps committed
53
inotify_add_watch f mask fname inot=:{fd,watches}
54 55 56 57 58
	# w = c_add_watch fd (packString fname) mask
	| w == -1
		# (err,inot) = errno inot
		= (Left err,inot)
	= (Right w, {inot & watches=[(w,f):watches]})
Camil Staps's avatar
Camil Staps committed
59
where
60
	c_add_watch :: !Int !String !Int -> Int
Camil Staps's avatar
Camil Staps committed
61
	c_add_watch inot fname mask = code {
62
		ccall inotify_add_watch "IsI:I"
Camil Staps's avatar
Camil Staps committed
63 64
	}

65
inotify_rm_watch :: !INWatch !*(Inotify st) -> *(!Bool, !*Inotify st)
Camil Staps's avatar
Camil Staps committed
66
inotify_rm_watch w inot=:{fd}
67 68 69
	= case c_inotify_rm_watch fd w of
		0 -> (True,  inot)
		_ -> (False, inot)
Camil Staps's avatar
Camil Staps committed
70
where
71
	c_inotify_rm_watch :: !Int !Int -> Int
Camil Staps's avatar
Camil Staps committed
72
	c_inotify_rm_watch w i = code {
73
		ccall inotify_rm_watch "II:I"
Camil Staps's avatar
Camil Staps committed
74 75
	}

76 77
inotify_poll :: !(Maybe Int) !*(Inotify st) -> *(!Int, !*Inotify st)
inotify_poll mbTo inot=:{fd} = let (n,fd`)=c_poll fd to in (n, {inot & fd=fd`})
Camil Staps's avatar
Camil Staps committed
78
where
79 80
	to = if (isNothing mbTo) -1 (fromJust mbTo)

81
	c_poll :: !Int !Int -> (!Int, !Int)
82 83
	c_poll fd timeout = code {
		ccall clean_poll "II:VII"
Camil Staps's avatar
Camil Staps committed
84 85
	}

86
inotify_check :: !*(Inotify st) !*World -> *(!*Inotify st, !*World)
Camil Staps's avatar
Camil Staps committed
87
inotify_check inot=:{fd,watches,state} w
88
	# (ok, wds, masks, fnames, fd) = c_check fd
Camil Staps's avatar
Camil Staps committed
89 90 91
	  inot = { inot & fd=fd }
	| not ok = (inot, w)
	| (size wds) rem 4 <> 0 || (size masks) rem 4 <> 0 = (inot,w)
92
	# (wds,masks,fnames) = (split 4 wds, split 4 masks, splitOn '\0' fnames)
Camil Staps's avatar
Camil Staps committed
93
	| length wds <> length masks = (inot, w)
94 95
	# infos = zip3 (map bytesToInt wds) (map bytesToInt masks) fnames
	# (fd,st,w`) = seq (map (check infos) watches) (inot.fd, state, w)
Camil Staps's avatar
Camil Staps committed
96 97
	= ({ inot & fd=fd, state=st }, w`)
where
98 99
	check :: [(Int,Int,String)] (INWatch, INCallback st) *(Int, st, *World)
	      -> *(Int, st, *World)
100 101 102
	check infos (watch,f) (fd,st,w)
		# (st,w) = seq [\(st,w) -> f mask (toMaybe name) st w
		                \\ (wd,mask,name) <- infos | wd == watch] (st,w)
Camil Staps's avatar
Camil Staps committed
103
		= (fd,st,w)
104 105 106
	where
		toMaybe :: String -> Maybe String
		toMaybe s  = if (s=="") Nothing (Just s)
Camil Staps's avatar
Camil Staps committed
107 108 109 110 111 112 113 114 115

	bytesToInt :: {#Char} -> Int
	bytesToInt cs = sum [toInt c * (8 ^ p) \\ c <-: cs & p <- [0..]]

	split :: Int String -> [String]
	split n s
		| size s > n = [s % (0,n-1) : split n (s % (n, size s - 1))]
		| size s == n = [s]
		| s == "" = []
116 117 118 119 120 121 122 123

	splitOn :: Char String -> [String]
	splitOn c s = map toString (split` c [c \\ c <-: s])
	where
		split` :: Char [Char] -> [[Char]]
		split` c [] = []
		split` c cs=:[x:xs]
			= let (l,r) = span ((<>)c) cs in [l:split` c (removeMember c r)]
Camil Staps's avatar
Camil Staps committed
124
	
125
	c_check :: !Int -> (!Bool, !String, !String, !String, !Int)
Camil Staps's avatar
Camil Staps committed
126
	c_check fd = code {
127
		ccall clean_inotify_check "I:VISSSI"
Camil Staps's avatar
Camil Staps committed
128 129
	}

130 131 132
inotify_is_event :: INMask INEvent -> Bool
inotify_is_event mask ev = ev bitand mask <> 0

Camil Staps's avatar
Camil Staps committed
133 134
inotify_loop_with_timeout :: !(Maybe Int) !*(Inotify st) !*World
                          -> *(!*Inotify st, !*World)
135 136 137
inotify_loop_with_timeout to inot w
	# (n,inot) = inotify_poll to inot
	| n == 0   = (inot,w)
138
	# (inot,w) = inotify_check inot w
139 140 141 142
	= inotify_loop_with_timeout to inot w

inotify_loop_forever :: !*(Inotify st) !*World -> *(!*Inotify st, !*World)
inotify_loop_forever inot w = inotify_loop_with_timeout Nothing inot w