implementation module Inotify

import StdArray
import StdBool
import StdEnum
import StdFunc
import StdInt
import StdList
from StdOverloaded import class zero(zero)
import StdString

import Data.Either
import Data.List
import Data.Maybe
import System._Pointer
import System._Posix

import code from "inotify_c.o"

:: *Inotify st =
	{ fd      :: !Int
	, watches :: ![(INWatch, INCallback st)]
	, state   :: !st
	}

:: INWatch :== Int

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

inotify_init :: st -> Maybe *(Inotify st)
inotify_init st
	# (fd,_) = c_init 0
	| fd < 0 = Nothing
	# (i,_)  = fcntlArg fd 00004000 0 37 // IN_NONBLOCK
	| i <> i = Nothing
	= Just {fd=fd, watches=[], state=st}
where
	c_init :: !Int -> (!Int, !Int)
	c_init i = code {
		ccall inotify_init ":I:I"
	}

inotify_close :: *(Inotify st) -> st
inotify_close {fd,state} = c_close fd state
where
	c_close :: !Int !st -> st
	c_close fd st = code {
		ccall close "I:V:A"
	}

inotify_add_watch :: (INCallback st) !INMask !String !*(Inotify st)
                  -> *(!Either Int INWatch, !*Inotify st)
inotify_add_watch f mask fname inot=:{fd,watches}
	# w = c_add_watch fd (packString fname) mask
	| w == -1
		# (err,inot) = errno inot
		= (Left err,inot)
	= (Right w, {inot & watches=[(w,f):watches]})
where
	c_add_watch :: !Int !String !Int -> Int
	c_add_watch inot fname mask = code {
		ccall inotify_add_watch "IsI:I"
	}

inotify_rm_watch :: !INWatch !*(Inotify st) -> *(!Bool, !*Inotify st)
inotify_rm_watch w inot=:{fd}
	= case c_inotify_rm_watch fd w of
		0 -> (True,  inot)
		_ -> (False, inot)
where
	c_inotify_rm_watch :: !Int !Int -> Int
	c_inotify_rm_watch w i = code {
		ccall inotify_rm_watch "II:I"
	}

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`})
where
	to = if (isNothing mbTo) -1 (fromJust mbTo)

	c_poll :: !Int !Int -> (!Int, !Int)
	c_poll fd timeout = code {
		ccall clean_poll "II:VII"
	}

inotify_check :: !*(Inotify st) !*World -> *(!*Inotify st, !*World)
inotify_check inot=:{fd,watches,state} w
	# (ok, wds, masks, fnames, fd) = c_check fd
	  inot = { inot & fd=fd }
	| not ok = (inot, w)
	| (size wds) rem 4 <> 0 || (size masks) rem 4 <> 0 = (inot,w)
	# (wds,masks,fnames) = (split 4 wds, split 4 masks, splitOn '\0' fnames)
	| length wds <> length masks = (inot, w)
	# infos = zip3 (map bytesToInt wds) (map bytesToInt masks) fnames
	# (fd,st,w`) = seq (map (check infos) watches) (inot.fd, state, w)
	= ({ inot & fd=fd, state=st }, w`)
where
	check :: [(Int,Int,String)] (INWatch, INCallback st) *(Int, st, *World)
	      -> *(Int, st, *World)
	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)
		= (fd,st,w)
	where
		toMaybe :: String -> Maybe String
		toMaybe s  = if (s=="") Nothing (Just s)

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

	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 == "" = []

	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)]
	
	c_check :: !Int -> (!Bool, !String, !String, !String, !Int)
	c_check fd = code {
		ccall clean_inotify_check "I:VISSSI"
	}

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

inotify_loop_with_timeout :: !(Maybe Int) !*(Inotify st) !*World
                          -> *(!*Inotify st, !*World)
inotify_loop_with_timeout to inot w
	# (n,inot) = inotify_poll to inot
	| n == 0   = (inot,w)
	# (inot,w) = inotify_check inot w
	= 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