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

module Hercules.CNix.Settings
  ( getExtraPlatforms,
    getSystem,
    getSystemFeatures,
    getSubstituters,
    getTrustedPublicKeys,
    getNarinfoCacheNegativeTtl,
    getNetrcFile,
    getUseSQLiteWAL,
    setUseSQLiteWAL,
  )
where

import Data.ByteString.Unsafe (unsafePackMallocCString)
import qualified Data.Set as S
import Foreign (fromBool, toBool)
import Hercules.CNix.Encapsulation (moveToForeignPtrWrapper)
import qualified Hercules.CNix.Std.Set as Std.Set
import qualified Hercules.CNix.Std.String as Std.String
import Hercules.CNix.Std.String.Instances ()
import qualified Hercules.CNix.Std.Vector as Std.Vector
import Hercules.CNix.Store.Context (context)
import qualified Language.C.Inline.Cpp as C
import Protolude hiding (evalState, throwIO)

C.context
  ( context
      <> Std.Set.stdSetCtx
      <> Std.String.stdStringCtx
      <> Std.Vector.stdVectorCtx
  )

C.include "<cstring>"
C.include "<nix/config.h>"
C.include "<nix/globals.hh>"
C.include "<set>"
C.include "<string>"

byteStringSet :: IO (Ptr (Std.Set.CStdSet Std.String.CStdString)) -> IO (Set ByteString)
byteStringSet :: IO (Ptr (CStdSet CStdString)) -> IO (Set ByteString)
byteStringSet IO (Ptr (CStdSet CStdString))
x =
  IO (Ptr (CStdSet CStdString))
x
    IO (Ptr (CStdSet CStdString))
-> (Ptr (CStdSet CStdString) -> IO (StdSet CStdString))
-> IO (StdSet CStdString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (CStdSet CStdString) -> IO (StdSet CStdString)
forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
    IO (StdSet CStdString)
-> (StdSet CStdString -> IO [StdString]) -> IO [StdString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdSet CStdString -> IO [StdString]
forall a b.
(HasStdSet a, HasEncapsulation a b) =>
StdSet a -> IO [b]
Std.Set.toListFP
    IO [StdString]
-> ([StdString] -> IO [ByteString]) -> IO [ByteString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StdString -> IO ByteString) -> [StdString] -> IO [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse StdString -> IO ByteString
Std.String.copyToByteString
    IO [ByteString]
-> ([ByteString] -> Set ByteString) -> IO (Set ByteString)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
S.fromList

byteStringList :: IO (Ptr (Std.Vector.CStdVector Std.String.CStdString)) -> IO [ByteString]
byteStringList :: IO (Ptr (CStdVector CStdString)) -> IO [ByteString]
byteStringList IO (Ptr (CStdVector CStdString))
x =
  IO (Ptr (CStdVector CStdString))
x
    IO (Ptr (CStdVector CStdString))
-> (Ptr (CStdVector CStdString) -> IO (StdVector CStdString))
-> IO (StdVector CStdString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (CStdVector CStdString) -> IO (StdVector CStdString)
forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
    IO (StdVector CStdString)
-> (StdVector CStdString -> IO [StdString]) -> IO [StdString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdVector CStdString -> IO [StdString]
forall a b.
(HasEncapsulation a b, HasStdVector a) =>
StdVector a -> IO [b]
Std.Vector.toListFP
    IO [StdString]
-> ([StdString] -> IO [ByteString]) -> IO [ByteString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StdString -> IO ByteString) -> [StdString] -> IO [ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse StdString -> IO ByteString
Std.String.copyToByteString

getExtraPlatforms :: IO (Set ByteString)
getExtraPlatforms :: IO (Set ByteString)
getExtraPlatforms =
  IO (Ptr (CStdSet CStdString)) -> IO (Set ByteString)
byteStringSet
    IO (Ptr (CStdSet CStdString))
[C.block| std::set<std::string>*{
      return new nix::StringSet(nix::settings.extraPlatforms.get());
    }|]

getSystem :: IO ByteString
getSystem :: IO ByteString
getSystem =
  CString -> IO ByteString
unsafePackMallocCString
    (CString -> IO ByteString) -> IO CString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString
[C.exp| const char *{
      strdup(nix::settings.thisSystem.get().c_str())
    }|]

getSystemFeatures :: IO (Set ByteString)
getSystemFeatures :: IO (Set ByteString)
getSystemFeatures =
  IO (Ptr (CStdSet CStdString)) -> IO (Set ByteString)
byteStringSet
    IO (Ptr (CStdSet CStdString))
[C.block| std::set<std::string>*{
      return new nix::StringSet(nix::settings.systemFeatures.get());
    }|]

getSubstituters :: IO [ByteString]
getSubstituters :: IO [ByteString]
getSubstituters =
  IO (Ptr (CStdVector CStdString)) -> IO [ByteString]
byteStringList
    IO (Ptr (CStdVector CStdString))
[C.block| std::vector<std::string>*{
      auto r = new std::vector<std::string>();
      for (auto i : nix::settings.substituters.get())
        r->push_back(i);
      return r;
    }|]

getTrustedPublicKeys :: IO [ByteString]
getTrustedPublicKeys :: IO [ByteString]
getTrustedPublicKeys =
  IO (Ptr (CStdVector CStdString)) -> IO [ByteString]
byteStringList
    IO (Ptr (CStdVector CStdString))
[C.block| std::vector<std::string>*{
      auto r = new std::vector<std::string>();
      for (auto i : nix::settings.trustedPublicKeys.get())
        r->push_back(i);
      return r;
    }|]

getNarinfoCacheNegativeTtl :: IO Word64
getNarinfoCacheNegativeTtl :: IO Word64
getNarinfoCacheNegativeTtl =
  IO Word64
[C.exp| uint64_t{
    nix::settings.ttlNegativeNarInfoCache.get()
  }|]

getNetrcFile :: IO ByteString
getNetrcFile :: IO ByteString
getNetrcFile =
  CString -> IO ByteString
unsafePackMallocCString
    (CString -> IO ByteString) -> IO CString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString
[C.exp| const char *{
      strdup(nix::settings.netrcFile.get().c_str())
    }|]

-- Gets the value of https://nixos.org/manual/nix/stable/command-ref/conf-file.html?highlight=use-sqlite-wal#conf-use-sqlite-wal
getUseSQLiteWAL :: IO Bool
getUseSQLiteWAL :: IO Bool
getUseSQLiteWAL = do
  IO CBool
[C.exp| bool { nix::settings.useSQLiteWAL }|] IO CBool -> (CBool -> Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool

-- Sets the value of https://nixos.org/manual/nix/stable/command-ref/conf-file.html?highlight=use-sqlite-wal#conf-use-sqlite-wal
setUseSQLiteWAL :: Bool -> IO ()
setUseSQLiteWAL :: Bool -> IO ()
setUseSQLiteWAL Bool
value = do
  let v :: CBool
v = Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
value
  [C.block| void { nix::settings.useSQLiteWAL = $(bool v); }|]