implementation module Inotify

import Data.Either
import Data.List
import Data.Maybe

import StdArray
import StdBool
import StdFunc
import StdInt
import StdList
import StdString

from StdOverloaded import class zero(zero)

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
	= let fd=c_init 0 in if (fd<0) Nothing (Just {fd=fd, watches=[], state=st})
where
	c_init :: !Int -> *Int
	c_init i = code {
		ccall clean_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) !Int !String !*(Inotify st)
                  -> *(Either Int INWatch, *Inotify st)
inotify_add_watch f mask fname inot=:{fd,watches}
	= let (w, fd`) = c_add_watch fd fname mask in
		( if (w == -1) (Left errno) (Right w)
		, {inot & fd=fd`, watches=[(w,f):watches]}
		)
where
	c_add_watch :: !*Int !String !Int -> *(!Int, !*Int)
	c_add_watch inot fname mask = code {
		ccall clean_inotify_add_watch "ISI:VII"
	}

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

inotify_poll :: *(Inotify st) -> *Inotify st
inotify_poll inot=:{fd} = let (_,fd`) = c_poll fd in { inot & fd=fd` }
where
	c_poll :: !*Int -> *(!Int, !*Int)
	c_poll fd = code {
		ccall clean_poll "I: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 * (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 == "" = []

	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_loop_forever :: *(Inotify st) *World -> *(*Inotify st, *World)
inotify_loop_forever inot w
	# inot = inotify_poll inot
	# (inot,w) = inotify_check inot w
	= inotify_loop_forever inot w

errno :: Int
errno = err 0
where
	err :: !Int -> Int
	err i = code {
		ccall clean_errno "I:I"
	}