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

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

import Data.ByteString.Unsafe (unsafePackMallocCString)
import qualified Data.Set as S
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
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b.
(HasStdSet a, HasEncapsulation a b) =>
StdSet a -> IO [b]
Std.Set.toListFP
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse StdString -> IO ByteString
Std.String.copyToByteString
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b.
(HasEncapsulation a b, HasStdVector a) =>
StdVector a -> IO [b]
Std.Vector.toListFP
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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
    [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
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [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
    [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
    [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
    [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 =
  [C.exp| uint64_t{
    nix::settings.ttlNegativeNarInfoCache.get()
  }|]

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