module Memfd.CreateOptionsFlags (createOptionsFlags) where

import Control.Monad (return)
import Control.Monad.Trans.State.Strict (State, execState, modify')
import Data.Maybe (Maybe (..))
import Data.Monoid (mempty, (<>))
import Memfd.CreateFlags qualified as Flags
import Memfd.CreateFlagsType (CreateFlags)
import Memfd.CreateOptionsType (CreateOptions (..))
import Memfd.FileSystemType (FileSystem (..))
import Memfd.HugeTLBOptionsType (HugeTLBOptions (..))
import Memfd.OnExecType (OnExec (RemainOpenOnExec, CloseOnExec))
import Memfd.SealingType (Sealing (DoNotAllowSealing, AllowSealing))

createOptionsFlags :: CreateOptions -> CreateFlags
createOptionsFlags :: CreateOptions -> CreateFlags
createOptionsFlags CreateOptions
x = forall s a. State s a -> s -> s
execState (CreateOptions -> State CreateFlags ()
setOptionFlags CreateOptions
x) forall a. Monoid a => a
mempty

setOptionFlags :: CreateOptions -> State CreateFlags ()
setOptionFlags :: CreateOptions -> State CreateFlags ()
setOptionFlags CreateOptions
x =
  do
    case CreateOptions -> OnExec
onExec CreateOptions
x of
        OnExec
CloseOnExec -> CreateFlags -> State CreateFlags ()
setFlags CreateFlags
Flags.closeOnExec
        OnExec
RemainOpenOnExec -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case CreateOptions -> Sealing
sealing CreateOptions
x of
        Sealing
AllowSealing -> CreateFlags -> State CreateFlags ()
setFlags CreateFlags
Flags.allowSealing
        Sealing
DoNotAllowSealing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case CreateOptions -> FileSystem
fileSystem CreateOptions
x of
        FileSystem
TemporaryFileSystem -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        HugeTLBFileSystem HugeTLBOptions
y -> HugeTLBOptions -> State CreateFlags ()
setHugeTLBFlags HugeTLBOptions
y

setHugeTLBFlags :: HugeTLBOptions -> State CreateFlags ()
setHugeTLBFlags :: HugeTLBOptions -> State CreateFlags ()
setHugeTLBFlags HugeTLBOptions
x =
  do
    CreateFlags -> State CreateFlags ()
setFlags CreateFlags
Flags.hugeTLB
    case HugeTLBOptions
x of
        HugeTLBOptions
DefaultHugeTLB -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        HugeTLBSize HugeTLBSize
y ->
            case HugeTLBSize -> Maybe CreateFlags
Flags.hugeTLBSize HugeTLBSize
y of
                Maybe CreateFlags
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just CreateFlags
z -> CreateFlags -> State CreateFlags ()
setFlags CreateFlags
z

setFlags :: CreateFlags -> State CreateFlags ()
setFlags :: CreateFlags -> State CreateFlags ()
setFlags CreateFlags
x = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Semigroup a => a -> a -> a
<> CreateFlags
x)