module System.CGroup.Controller.Internal (
Controller (..),
resolveCGroupController,
resolveCGroupController',
CGroup (..),
Mount (..),
findMatchingCGroup,
resolveControllerMountPath,
tryResolveMount,
parseMountInfo,
parseCGroups,
Parser,
) where
import Control.Exception (throwIO)
import Control.Monad (guard)
import Data.Char (isSpace)
import Data.Foldable (find)
import Data.Maybe (listToMaybe, mapMaybe)
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 (Parsec, eof, manyTill, optional, parse, skipMany, some, takeWhile1P, takeWhileP)
import Text.Megaparsec.Char (char)
import qualified Text.Megaparsec.Char.Lexer as L
newtype Controller a = Controller {Controller a -> Path Abs Dir
unController :: Path Abs Dir}
deriving (Controller a -> Controller a -> Bool
(Controller a -> Controller a -> Bool)
-> (Controller a -> Controller a -> Bool) -> Eq (Controller a)
forall a. Controller a -> Controller a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Controller a -> Controller a -> Bool
$c/= :: forall a. Controller a -> Controller a -> Bool
== :: Controller a -> Controller a -> Bool
$c== :: forall a. Controller a -> Controller a -> Bool
Eq, Eq (Controller a)
Eq (Controller a)
-> (Controller a -> Controller a -> Ordering)
-> (Controller a -> Controller a -> Bool)
-> (Controller a -> Controller a -> Bool)
-> (Controller a -> Controller a -> Bool)
-> (Controller a -> Controller a -> Bool)
-> (Controller a -> Controller a -> Controller a)
-> (Controller a -> Controller a -> Controller a)
-> Ord (Controller a)
Controller a -> Controller a -> Bool
Controller a -> Controller a -> Ordering
Controller a -> Controller a -> Controller a
forall a. Eq (Controller a)
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
forall a. Controller a -> Controller a -> Bool
forall a. Controller a -> Controller a -> Ordering
forall a. Controller a -> Controller a -> Controller a
min :: Controller a -> Controller a -> Controller a
$cmin :: forall a. Controller a -> Controller a -> Controller a
max :: Controller a -> Controller a -> Controller a
$cmax :: forall a. Controller a -> Controller a -> Controller a
>= :: Controller a -> Controller a -> Bool
$c>= :: forall a. Controller a -> Controller a -> Bool
> :: Controller a -> Controller a -> Bool
$c> :: forall a. Controller a -> Controller a -> Bool
<= :: Controller a -> Controller a -> Bool
$c<= :: forall a. Controller a -> Controller a -> Bool
< :: Controller a -> Controller a -> Bool
$c< :: forall a. Controller a -> Controller a -> Bool
compare :: Controller a -> Controller a -> Ordering
$ccompare :: forall a. Controller a -> Controller a -> Ordering
$cp1Ord :: forall a. Eq (Controller a)
Ord, Int -> Controller a -> ShowS
[Controller a] -> ShowS
Controller a -> String
(Int -> Controller a -> ShowS)
-> (Controller a -> String)
-> ([Controller a] -> ShowS)
-> Show (Controller a)
forall a. Int -> Controller a -> ShowS
forall a. [Controller a] -> ShowS
forall a. Controller a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Controller a] -> ShowS
$cshowList :: forall a. [Controller a] -> ShowS
show :: Controller a -> String
$cshow :: forall a. Controller a -> String
showsPrec :: Int -> Controller a -> ShowS
$cshowsPrec :: forall a. Int -> Controller a -> ShowS
Show)
resolveCGroupController :: Text -> IO (Controller a)
resolveCGroupController :: Text -> IO (Controller a)
resolveCGroupController Text
controller = do
Path Abs File
cgroupPath <- String -> IO (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
"/proc/self/cgroup"
Path Abs File
mountinfoPath <- String -> IO (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
"/proc/self/mountinfo"
Path Abs File -> Path Abs File -> Text -> IO (Controller a)
forall a.
Path Abs File -> Path Abs File -> Text -> IO (Controller a)
resolveCGroupController' Path Abs File
cgroupPath Path Abs File
mountinfoPath Text
controller
resolveCGroupController' :: Path Abs File -> Path Abs File -> Text -> IO (Controller a)
resolveCGroupController' :: Path Abs File -> Path Abs File -> Text -> IO (Controller a)
resolveCGroupController' Path Abs File
cgroupPath Path Abs File
mountinfoPath Text
controllerName = do
[CGroup]
cgroups <- Parser [CGroup] -> Path Abs File -> IO [CGroup]
forall a b. Parser a -> Path b File -> IO a
parseFile Parser [CGroup]
parseCGroups Path Abs File
cgroupPath
[Mount]
mounts <- Parser [Mount] -> Path Abs File -> IO [Mount]
forall a b. Parser a -> Path b File -> IO a
parseFile Parser [Mount]
parseMountInfo Path Abs File
mountinfoPath
CGroup
cgroup <- IO CGroup -> (CGroup -> IO CGroup) -> Maybe CGroup -> IO CGroup
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO CGroup
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Couldn't find cgroup for controller") CGroup -> IO CGroup
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [CGroup] -> Maybe CGroup
findMatchingCGroup Text
controllerName [CGroup]
cgroups)
Path Abs Dir
resolved <- IO (Path Abs Dir)
-> (Path Abs Dir -> IO (Path Abs Dir))
-> Maybe (Path Abs Dir)
-> IO (Path Abs Dir)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO (Path Abs Dir)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Couldn't find mount for cgroup") Path Abs Dir -> IO (Path Abs Dir)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> CGroup -> [Mount] -> Maybe (Path Abs Dir)
resolveControllerMountPath Text
controllerName CGroup
cgroup [Mount]
mounts)
Controller a -> IO (Controller a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> Controller a
forall a. Path Abs Dir -> Controller a
Controller Path Abs Dir
resolved)
parseFile :: Parser a -> Path b File -> IO a
parseFile :: 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)
findMatchingCGroup :: Text -> [CGroup] -> Maybe CGroup
findMatchingCGroup :: Text -> [CGroup] -> Maybe CGroup
findMatchingCGroup Text
controllerName = (CGroup -> Bool) -> [CGroup] -> Maybe CGroup
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CGroup
group -> CGroup -> Bool
containsController CGroup
group Bool -> Bool -> Bool
|| CGroup -> Bool
emptyControllers CGroup
group)
where
containsController :: CGroup -> Bool
containsController :: CGroup -> Bool
containsController = (Text
controllerName Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Text] -> Bool) -> (CGroup -> [Text]) -> CGroup -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGroup -> [Text]
controlGroupControllers
emptyControllers :: CGroup -> Bool
emptyControllers :: CGroup -> Bool
emptyControllers = [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> (CGroup -> [Text]) -> CGroup -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGroup -> [Text]
controlGroupControllers
resolveControllerMountPath :: Text -> CGroup -> [Mount] -> Maybe (Path Abs Dir)
resolveControllerMountPath :: Text -> CGroup -> [Mount] -> Maybe (Path Abs Dir)
resolveControllerMountPath Text
controllerName CGroup
cgroup = (Mount -> Maybe (Path Abs Dir)) -> [Mount] -> Maybe (Path Abs Dir)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstMaybe (Text -> CGroup -> Mount -> Maybe (Path Abs Dir)
tryResolveMount Text
controllerName CGroup
cgroup)
firstMaybe :: (a -> Maybe b) -> [a] -> Maybe b
firstMaybe :: (a -> Maybe b) -> [a] -> Maybe b
firstMaybe a -> Maybe b
f = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> ([a] -> [b]) -> [a] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f
tryResolveMount :: Text -> CGroup -> Mount -> Maybe (Path Abs Dir)
tryResolveMount :: Text -> CGroup -> Mount -> Maybe (Path Abs Dir)
tryResolveMount Text
controllerName CGroup
cgroup Mount
mount = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
"cgroup" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Mount -> Text
mountFilesystemType Mount
mount)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
controllerName Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Mount -> [Text]
mountSuperOptions Mount
mount)
if CGroup -> Path Abs Dir
controlGroupPath CGroup
cgroup Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Mount -> Path Abs Dir
mountRoot Mount
mount
then Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Mount -> Path Abs Dir
mountPoint Mount
mount)
else do
Path Rel Dir
rel <- Path Abs Dir -> Path Abs Dir -> Maybe (Path Rel Dir)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix (Mount -> Path Abs Dir
mountRoot Mount
mount) (CGroup -> Path Abs Dir
controlGroupPath CGroup
cgroup)
Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Mount -> Path Abs Dir
mountPoint Mount
mount Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rel)
data CGroup = CGroup
{ CGroup -> [Text]
controlGroupControllers :: [Text]
, CGroup -> Path Abs Dir
controlGroupPath :: Path Abs Dir
}
deriving (Int -> CGroup -> ShowS
[CGroup] -> ShowS
CGroup -> String
(Int -> CGroup -> ShowS)
-> (CGroup -> String) -> ([CGroup] -> ShowS) -> Show CGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CGroup] -> ShowS
$cshowList :: [CGroup] -> ShowS
show :: CGroup -> String
$cshow :: CGroup -> String
showsPrec :: Int -> CGroup -> ShowS
$cshowsPrec :: Int -> CGroup -> ShowS
Show)
parseCGroups :: Parser [CGroup]
parseCGroups :: Parser [CGroup]
parseCGroups = ParsecT Void Text Identity CGroup -> Parser [CGroup]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity CGroup
parseSingleCGroup Parser [CGroup] -> ParsecT Void Text Identity () -> Parser [CGroup]
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 CGroup
parseSingleCGroup :: ParsecT Void Text Identity CGroup
parseSingleCGroup =
[Text] -> Path Abs Dir -> CGroup
CGroup
([Text] -> Path Abs Dir -> CGroup)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Text] -> Path Abs Dir -> CGroup)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Void Text Identity Text
takeUntil1P Char
':'
ParsecT Void Text Identity ([Text] -> Path Abs Dir -> CGroup)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity (Path Abs Dir -> CGroup)
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 -> CGroup)
-> ParsecT Void Text Identity (Path Abs Dir)
-> ParsecT Void Text Identity CGroup
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 Char)
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
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 Char)
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
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 -> Path Abs Dir
mountRoot :: Path Abs Dir
, Mount -> Path Abs Dir
mountPoint :: Path Abs Dir
, 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
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount
Mount
(Text
-> Text
-> Text
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text
-> Text
-> Path Abs Dir
-> Path Abs Dir
-> 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
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text
-> Path Abs Dir
-> Path Abs Dir
-> 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
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Path Abs Dir
-> Path Abs Dir
-> 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
(Path Abs Dir
-> Path Abs Dir
-> Text
-> [Text]
-> Text
-> Text
-> [Text]
-> Mount)
-> ParsecT Void Text Identity (Path Abs Dir)
-> ParsecT
Void
Text
Identity
(Path Abs Dir -> Text -> [Text] -> Text -> Text -> [Text] -> Mount)
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
=<< ParsecT Void Text Identity Text
field)
ParsecT
Void
Text
Identity
(Path Abs Dir -> Text -> [Text] -> Text -> Text -> [Text] -> Mount)
-> ParsecT Void Text Identity (Path Abs Dir)
-> ParsecT
Void
Text
Identity
(Text -> [Text] -> Text -> Text -> [Text] -> Mount)
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
=<< 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 Char)
-> ParsecT Void Text Identity Mount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
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')
type Parser = Parsec Void Text
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 :: Parser a -> Parser a
lexeme = ParsecT Void Text Identity () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme (ParsecT Void Text Identity Char -> 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