module System.CGroup.Types (
CPUQuota (..),
RawCGroup (..),
parseCGroups,
Mount (..),
parseMountInfo,
Parser,
parseFile,
) where
import Control.Exception (throwIO)
import Data.Char (isSpace)
import Data.Ratio
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as TIO
import Data.Void (Void)
import Path
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
data CPUQuota
= CPUQuota (Ratio Int)
| NoQuota
deriving (CPUQuota -> CPUQuota -> Bool
(CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool) -> Eq CPUQuota
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CPUQuota -> CPUQuota -> Bool
$c/= :: CPUQuota -> CPUQuota -> Bool
== :: CPUQuota -> CPUQuota -> Bool
$c== :: CPUQuota -> CPUQuota -> Bool
Eq, Eq CPUQuota
Eq CPUQuota
-> (CPUQuota -> CPUQuota -> Ordering)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> Bool)
-> (CPUQuota -> CPUQuota -> CPUQuota)
-> (CPUQuota -> CPUQuota -> CPUQuota)
-> Ord CPUQuota
CPUQuota -> CPUQuota -> Bool
CPUQuota -> CPUQuota -> Ordering
CPUQuota -> CPUQuota -> CPUQuota
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CPUQuota -> CPUQuota -> CPUQuota
$cmin :: CPUQuota -> CPUQuota -> CPUQuota
max :: CPUQuota -> CPUQuota -> CPUQuota
$cmax :: CPUQuota -> CPUQuota -> CPUQuota
>= :: CPUQuota -> CPUQuota -> Bool
$c>= :: CPUQuota -> CPUQuota -> Bool
> :: CPUQuota -> CPUQuota -> Bool
$c> :: CPUQuota -> CPUQuota -> Bool
<= :: CPUQuota -> CPUQuota -> Bool
$c<= :: CPUQuota -> CPUQuota -> Bool
< :: CPUQuota -> CPUQuota -> Bool
$c< :: CPUQuota -> CPUQuota -> Bool
compare :: CPUQuota -> CPUQuota -> Ordering
$ccompare :: CPUQuota -> CPUQuota -> Ordering
Ord, Int -> CPUQuota -> ShowS
[CPUQuota] -> ShowS
CPUQuota -> String
(Int -> CPUQuota -> ShowS)
-> (CPUQuota -> String) -> ([CPUQuota] -> ShowS) -> Show CPUQuota
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPUQuota] -> ShowS
$cshowList :: [CPUQuota] -> ShowS
show :: CPUQuota -> String
$cshow :: CPUQuota -> String
showsPrec :: Int -> CPUQuota -> ShowS
$cshowsPrec :: Int -> CPUQuota -> ShowS
Show)
data RawCGroup = RawCGroup
{ RawCGroup -> Text
rawCGroupId :: Text
, RawCGroup -> [Text]
rawCGroupControllers :: [Text]
, RawCGroup -> Path Abs Dir
rawCGroupPath :: Path Abs Dir
}
deriving (Int -> RawCGroup -> ShowS
[RawCGroup] -> ShowS
RawCGroup -> String
(Int -> RawCGroup -> ShowS)
-> (RawCGroup -> String)
-> ([RawCGroup] -> ShowS)
-> Show RawCGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawCGroup] -> ShowS
$cshowList :: [RawCGroup] -> ShowS
show :: RawCGroup -> String
$cshow :: RawCGroup -> String
showsPrec :: Int -> RawCGroup -> ShowS
$cshowsPrec :: Int -> RawCGroup -> ShowS
Show)
parseCGroups :: Parser [RawCGroup]
parseCGroups :: Parser [RawCGroup]
parseCGroups = ParsecT Void Text Identity RawCGroup -> Parser [RawCGroup]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity RawCGroup
parseSingleCGroup Parser [RawCGroup]
-> ParsecT Void Text Identity () -> Parser [RawCGroup]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
parseSingleCGroup :: Parser RawCGroup
parseSingleCGroup :: ParsecT Void Text Identity RawCGroup
parseSingleCGroup =
Text -> [Text] -> Path Abs Dir -> RawCGroup
RawCGroup
(Text -> [Text] -> Path Abs Dir -> RawCGroup)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Text] -> Path Abs Dir -> RawCGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Void Text Identity Text
takeUntil1P Char
':'
ParsecT Void Text Identity ([Text] -> Path Abs Dir -> RawCGroup)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity (Path Abs Dir -> RawCGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Text -> [Text]
splitOnIgnoreEmpty Text
"," (Text -> [Text])
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Void Text Identity Text
takeUntilP Char
':')
ParsecT Void Text Identity (Path Abs Dir -> RawCGroup)
-> ParsecT Void Text Identity (Path Abs Dir)
-> ParsecT Void Text Identity RawCGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ParsecT Void Text Identity (Path Abs Dir)
parseIntoAbsDir (Text -> ParsecT Void Text Identity (Path Abs Dir))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Char -> ParsecT Void Text Identity Text
takeUntil1P Char
'\n')
takeUntilP :: Char -> Parser Text
takeUntilP :: Char -> ParsecT Void Text Identity Text
takeUntilP Char
c = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c) ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe (Token Text))
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
c)
takeUntil1P :: Char -> Parser Text
takeUntil1P :: Char -> ParsecT Void Text Identity Text
takeUntil1P Char
c = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c) ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe (Token Text))
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
c)
splitOnIgnoreEmpty :: Text -> Text -> [Text]
splitOnIgnoreEmpty :: Text -> Text -> [Text]
splitOnIgnoreEmpty Text
_ Text
"" = []
splitOnIgnoreEmpty Text
s Text
str = Text -> Text -> [Text]
Text.splitOn Text
s Text
str
data Mount = Mount
{ Mount -> Text
mountId :: Text
, Mount -> Text
mountParentId :: Text
, Mount -> Text
mountStDev :: Text
, Mount -> Text
mountRoot :: Text
, Mount -> Text
mountPoint :: Text
, Mount -> Text
mountOptions :: Text
, Mount -> [Text]
mountTags :: [Text]
, Mount -> Text
mountFilesystemType :: Text
, Mount -> Text
mountSource :: Text
, Mount -> [Text]
mountSuperOptions :: [Text]
}
deriving (Int -> Mount -> ShowS
[Mount] -> ShowS
Mount -> String
(Int -> Mount -> ShowS)
-> (Mount -> String) -> ([Mount] -> ShowS) -> Show Mount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mount] -> ShowS
$cshowList :: [Mount] -> ShowS
show :: Mount -> String
$cshow :: Mount -> String
showsPrec :: Int -> Mount -> ShowS
$cshowsPrec :: Int -> Mount -> ShowS
Show)
parseMountInfo :: Parser [Mount]
parseMountInfo :: Parser [Mount]
parseMountInfo = ParsecT Void Text Identity Mount -> Parser [Mount]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Mount
parseSingleMount Parser [Mount] -> ParsecT Void Text Identity () -> Parser [Mount]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
parseSingleMount :: Parser Mount
parseSingleMount :: ParsecT Void Text Identity Mount
parseSingleMount =
Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount
Mount
(Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
field
ParsecT
Void
Text
Identity
(Text
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text
-> Text
-> Text
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT
Void
Text
Identity
(Text
-> Text
-> Text
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> Text -> Text -> [Text] -> Text -> Text -> [Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT
Void
Text
Identity
(Text -> Text -> Text -> [Text] -> Text -> Text -> [Text] -> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> Text -> [Text] -> Text -> Text -> [Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT
Void
Text
Identity
(Text -> Text -> [Text] -> Text -> Text -> [Text] -> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> [Text] -> Text -> Text -> [Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT
Void
Text
Identity
(Text -> [Text] -> Text -> Text -> [Text] -> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void Text Identity ([Text] -> Text -> Text -> [Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT
Void Text Identity ([Text] -> Text -> Text -> [Text] -> Mount)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity (Text -> Text -> [Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT Void Text Identity Char
separator
ParsecT Void Text Identity (Text -> Text -> [Text] -> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> [Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT Void Text Identity (Text -> [Text] -> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Text] -> Mount)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
field
ParsecT Void Text Identity ([Text] -> Mount)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Mount
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Text -> [Text]
splitOnIgnoreEmpty Text
"," (Text -> [Text])
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
field)
ParsecT Void Text Identity Mount
-> ParsecT Void Text Identity (Maybe (Token Text))
-> ParsecT Void Text Identity Mount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Maybe (Token Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n')
field :: Parser Text
field :: ParsecT Void Text Identity Text
field = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
separator :: Parser Char
separator :: ParsecT Void Text Identity Char
separator = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme (ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '))
parseIntoAbsDir :: Text -> Parser (Path Abs Dir)
parseIntoAbsDir :: Text -> ParsecT Void Text Identity (Path Abs Dir)
parseIntoAbsDir = (SomeException -> ParsecT Void Text Identity (Path Abs Dir))
-> (Path Abs Dir -> ParsecT Void Text Identity (Path Abs Dir))
-> Either SomeException (Path Abs Dir)
-> ParsecT Void Text Identity (Path Abs Dir)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParsecT Void Text Identity (Path Abs Dir)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text Identity (Path Abs Dir))
-> (SomeException -> String)
-> SomeException
-> ParsecT Void Text Identity (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) Path Abs Dir -> ParsecT Void Text Identity (Path Abs Dir)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Path Abs Dir)
-> ParsecT Void Text Identity (Path Abs Dir))
-> (Text -> Either SomeException (Path Abs Dir))
-> Text
-> ParsecT Void Text Identity (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir (String -> Either SomeException (Path Abs Dir))
-> (Text -> String) -> Text -> Either SomeException (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
type Parser = Parsec Void Text
parseFile :: Parser a -> Path b File -> IO a
parseFile :: forall a b. Parser a -> Path b File -> IO a
parseFile Parser a
parser Path b File
file = (ParseErrorBundle Text Void -> IO a)
-> (a -> IO a) -> Either (ParseErrorBundle Text Void) a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text Void -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) a -> IO a)
-> (Text -> Either (ParseErrorBundle Text Void) a) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser a
parser (Path b File -> String
forall b t. Path b t -> String
toFilePath Path b File
file) (Text -> IO a) -> IO Text -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
TIO.readFile (Path b File -> String
forall b t. Path b t -> String
toFilePath Path b File
file)