{-# language BlockArguments #-}

module CreateOptionsFlags (createOptionsFlags) where

import CreateFlagsType (CreateFlags)
import CreateOptionsType (CreateOptions (..))
import FileSystemType (FileSystem (..))
import HugeTLBOptionsType (HugeTLBOptions (..))
import OnExecType (OnExec (RemainOpenOnExec, CloseOnExec))
import SealingType (Sealing (DoNotAllowSealing, AllowSealing))

import qualified CreateFlags as Flags

import Control.Monad (return)
import Control.Monad.Trans.State.Strict (State, execState, modify')
import Data.Maybe (Maybe (..))
import Data.Monoid (mempty, (<>))

createOptionsFlags :: CreateOptions -> CreateFlags
createOptionsFlags :: CreateOptions -> CreateFlags
createOptionsFlags CreateOptions
x = State CreateFlags () -> CreateFlags -> CreateFlags
forall s a. State s a -> s -> s
execState (CreateOptions -> State CreateFlags ()
setOptionFlags CreateOptions
x) CreateFlags
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 -> () -> State CreateFlags ()
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 -> () -> State CreateFlags ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case CreateOptions -> FileSystem
fileSystem CreateOptions
x of
        FileSystem
TemporaryFileSystem -> () -> State CreateFlags ()
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 -> () -> State CreateFlags ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        HugeTLBSize HugeTLBSize
y ->
            case HugeTLBSize -> Maybe CreateFlags
Flags.hugeTLBSize HugeTLBSize
y of
                Maybe CreateFlags
Nothing -> () -> State CreateFlags ()
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 = (CreateFlags -> CreateFlags) -> State CreateFlags ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (CreateFlags -> CreateFlags -> CreateFlags
forall a. Semigroup a => a -> a -> a
<> CreateFlags
x)