{-# 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)