{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Hercules.CNix
  ( init,
    setTalkative,
    setDebug,
    setGlobalOption,
    setOption,
    logInfo,
    appendString,
    nixVersion,

    -- * Re-exports
    module Hercules.CNix.Store,
  )
where

-- TODO: No more Ptr EvalState
-- TODO: No more NixStore when EvalState is already there

import Data.ByteString.Unsafe (unsafePackMallocCString)
import Hercules.CNix.Store
import Hercules.CNix.Verbosity
  ( Verbosity (Debug, Talkative),
    setVerbosity,
  )
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Cpp.Exception as C
import Protolude hiding (evalState, throwIO)
import System.IO.Unsafe (unsafePerformIO)

C.context context

C.include "<stdio.h>"

C.include "<cstring>"

C.include "<math.h>"

C.include "<nix/config.h>"

C.include "<nix/shared.hh>"

C.include "<nix/store-api.hh>"

C.include "<nix/get-drvs.hh>"

C.include "<nix/derivations.hh>"

C.include "<nix/globals.hh>"

C.include "hercules-ci-cnix/store.hxx"

C.include "<gc/gc.h>"

C.include "<gc/gc_cpp.h>"

C.include "<gc/gc_allocator.h>"

C.using "namespace nix"

init :: IO ()
init :: IO ()
init =
  IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    [C.throwBlock| void {
      nix::initNix();
    } |]

setTalkative :: IO ()
setTalkative :: IO ()
setTalkative = Verbosity -> IO ()
setVerbosity Verbosity
Talkative

setDebug :: IO ()
setDebug :: IO ()
setDebug = Verbosity -> IO ()
setVerbosity Verbosity
Debug

setGlobalOption :: Text -> Text -> IO ()
setGlobalOption :: Text -> Text -> IO ()
setGlobalOption Text
opt Text
value = do
  let optionStr :: ByteString
optionStr = Text -> ByteString
encodeUtf8 Text
opt
      valueStr :: ByteString
valueStr = Text -> ByteString
encodeUtf8 Text
value
  [C.throwBlock| void {
    globalConfig.set($bs-cstr:optionStr, $bs-cstr:valueStr);
  }|]

setOption :: Text -> Text -> IO ()
setOption :: Text -> Text -> IO ()
setOption Text
opt Text
value = do
  let optionStr :: ByteString
optionStr = Text -> ByteString
encodeUtf8 Text
opt
      valueStr :: ByteString
valueStr = Text -> ByteString
encodeUtf8 Text
value
  [C.throwBlock| void {
    settings.set($bs-cstr:optionStr, $bs-cstr:valueStr);
  }|]

logInfo :: Text -> IO ()
logInfo :: Text -> IO ()
logInfo Text
t = do
  let bstr :: ByteString
bstr = Text -> ByteString
encodeUtf8 Text
t
  [C.throwBlock| void {
    printInfo($bs-cstr:bstr);
  }|]

appendString :: Ptr Strings -> ByteString -> IO ()
appendString :: Ptr Strings -> ByteString -> IO ()
appendString Ptr Strings
ss ByteString
s =
  [C.block| void {
    $(Strings *ss)->push_back(std::string($bs-ptr:s, $bs-len:s));
  }|]

nixVersion :: ByteString
nixVersion :: ByteString
nixVersion = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  CString
p <-
    [C.exp| const char* {
      strdup(nix::nixVersion.c_str())
    }|]
  CString -> IO ByteString
unsafePackMallocCString CString
p
{-# NOINLINE nixVersion #-}