{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, LambdaCase #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Stopgap.System.GLib.File where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.C.String
import Control.Monad
import Control.Exception
import Data.Word
import Data.Int
import Stopgap.Data.Ptr

import Stopgap.System.GLib.Error qualified as G.Error
import Stopgap.System.GLib.Cancellable qualified as G.Cancellable

#include <gtk/gtk.h>

data FTag

newtype F = F (Ptr FTag) deriving Show

instance IsPtr F where type Tag F = FTag; fromPtr = F; toPtr (F p) = p

newForPath :: FilePath -> IO F
newForPath fp = F <$> withCString fp c_g_file_new_for_path

foreign import ccall "g_file_new_for_path" c_g_file_new_for_path ::
	CString -> IO (Ptr FTag)

loadContents :: (?makeEFuns :: [G.Error.MakeEFun]) =>
	F -> Maybe G.Cancellable.C -> IO (String, String)
loadContents (F f) (cancellableToPtr -> c) =
	alloca \pcnt -> alloca \plen -> alloca \petag -> alloca \pperr -> do
		rslt <- c_g_file_load_contents f c pcnt plen petag pperr
		when (rslt == #{const FALSE}) do
			perr <- peek pperr
			err <- G.Error.fromC =<< peek perr
			G.Error.free perr
			throw err
		cntlen <- (,) <$> peek pcnt <*> (fromIntegral <$> peek plen)
		cetag <- peek petag
		(,) <$> peekCStringLen cntlen <*> peekCString cetag

cancellableToPtr :: Maybe G.Cancellable.C -> Ptr G.Cancellable.CTag
cancellableToPtr = \case Nothing -> nullPtr; Just (G.Cancellable.C p) -> p

foreign import ccall "g_file_load_contents" c_g_file_load_contents ::
	Ptr FTag -> Ptr G.Cancellable.CTag -> Ptr CString ->
	Ptr #{type gsize} -> Ptr CString -> Ptr (Ptr G.Error.E_) ->
	IO #{type gboolean}

getBasename :: F -> IO String
getBasename (F f) = peekCString =<< c_g_file_get_basename f

foreign import ccall "g_file_get_basename" c_g_file_get_basename ::
	Ptr FTag -> IO CString