{-# LANGUAGE CPP #-}

module System.OsRelease.Megaparsec where

import           Control.Applicative
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Data.Char
import           Data.Functor
import           Data.Void

import qualified Text.Megaparsec               as MP
import qualified Text.Megaparsec.Char          as MP


-- | Parse the entire file, handling newlines and comments gracefully.
--
-- This parser generally shouldn't fail, but instead report a failed
-- parsed line as @Left@ value.
parseAssignments :: MP.Parsec
                      Void
                      String
                      [Either (MP.ParseError String Void) (String, String)]
parseAssignments :: Parsec
  Void String [Either (ParseError String Void) (String, String)]
parseAssignments =
  (\[[Either (ParseError String Void) (String, String)]]
xs [Either (ParseError String Void) (String, String)]
x -> [[Either (ParseError String Void) (String, String)]]
-> [Either (ParseError String Void) (String, String)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[Either (ParseError String Void) (String, String)]]
xs [Either (ParseError String Void) (String, String)]
-> [Either (ParseError String Void) (String, String)]
-> [Either (ParseError String Void) (String, String)]
forall a. [a] -> [a] -> [a]
++ [Either (ParseError String Void) (String, String)]
x) ([[Either (ParseError String Void) (String, String)]]
 -> [Either (ParseError String Void) (String, String)]
 -> [Either (ParseError String Void) (String, String)])
-> ParsecT
     Void
     String
     Identity
     [[Either (ParseError String Void) (String, String)]]
-> ParsecT
     Void
     String
     Identity
     ([Either (ParseError String Void) (String, String)]
      -> [Either (ParseError String Void) (String, String)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec
  Void String [Either (ParseError String Void) (String, String)]
-> ParsecT
     Void
     String
     Identity
     [[Either (ParseError String Void) (String, String)]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void String Identity String
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall b.
ParsecT Void String Identity b
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
line ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
MP.eol) ParsecT
  Void
  String
  Identity
  ([Either (ParseError String Void) (String, String)]
   -> [Either (ParseError String Void) (String, String)])
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity ()
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall b.
ParsecT Void String Identity b
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
line ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof
 where
  line :: ParsecT Void String Identity b
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
line ParsecT Void String Identity b
eol = [Parsec
   Void String [Either (ParseError String Void) (String, String)]]
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice'
    [ ParsecT Void String Identity b
comment ParsecT Void String Identity b
-> [Either (ParseError String Void) (String, String)]
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []
    , ParsecT Void String Identity b
blank ParsecT Void String Identity b
-> [Either (ParseError String Void) (String, String)]
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []
    , (Either (ParseError String Void) (String, String)
 -> [Either (ParseError String Void) (String, String)])
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
-> Parsec
     Void String [Either (ParseError String Void) (String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (Either (ParseError String Void) (String, String)
-> [Either (ParseError String Void) (String, String)]
-> [Either (ParseError String Void) (String, String)]
forall a. a -> [a] -> [a]
: [])
      ( (ParseError String Void
 -> ParsecT
      Void
      String
      Identity
      (Either (ParseError String Void) (String, String)))
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> m a) -> m a -> m a
MP.withRecovery (\ParseError String Void
e -> ParsecT Void String Identity b
-> ParsecT Void String Identity String
forall a.
Parsec Void String a -> ParsecT Void String Identity String
parseUntil ParsecT Void String Identity b
eol ParsecT Void String Identity String
-> Either (ParseError String Void) (String, String)
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ParseError String Void
-> Either (ParseError String Void) (String, String)
forall a b. a -> Either a b
Left ParseError String Void
e)
      (ParsecT
   Void
   String
   Identity
   (Either (ParseError String Void) (String, String))
 -> ParsecT
      Void
      String
      Identity
      (Either (ParseError String Void) (String, String)))
-> (ParsecT Void String Identity (String, String)
    -> ParsecT
         Void
         String
         Identity
         (Either (ParseError String Void) (String, String)))
-> ParsecT Void String Identity (String, String)
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String)
 -> Either (ParseError String Void) (String, String))
-> ParsecT Void String Identity (String, String)
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String)
-> Either (ParseError String Void) (String, String)
forall a b. b -> Either a b
Right
      (ParsecT Void String Identity (String, String)
 -> ParsecT
      Void
      String
      Identity
      (Either (ParseError String Void) (String, String)))
-> ParsecT Void String Identity (String, String)
-> ParsecT
     Void
     String
     Identity
     (Either (ParseError String Void) (String, String))
forall a b. (a -> b) -> a -> b
$ (ParsecT Void String Identity (String, String)
parseAssignment ParsecT Void String Identity (String, String)
-> ParsecT Void String Identity b
-> ParsecT Void String Identity (String, String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity b
eol)
      )
    ]
   where
    comment :: ParsecT Void String Identity b
comment = ParsecT Void String Identity ()
pWs ParsecT Void String Identity ()
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'#' ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity b
-> ParsecT Void String Identity String
forall a.
Parsec Void String a -> ParsecT Void String Identity String
parseUntil ParsecT Void String Identity b
eol ParsecT Void String Identity String
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity b
eol
    blank :: ParsecT Void String Identity b
blank   = ParsecT Void String Identity ()
pWs ParsecT Void String Identity ()
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity b
eol


-- | Parse a single line assignment and extract the right hand side.
-- This is only a subset of a shell parser, refer to the spec for
-- details.
parseAssignment :: MP.Parsec Void String (String, String)
parseAssignment :: ParsecT Void String Identity (String, String)
parseAssignment =
  (,) (String -> String -> (String, String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity ()
pWs ParsecT Void String Identity ()
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
key) ParsecT Void String Identity (String -> (String, String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'=' ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity String
qval ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity String
forall a. Monoid a => a
mempty) ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
pWs)
 where
  dropSpace :: String -> String
  dropSpace :: String -> String
dropSpace = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

  key :: MP.Parsec Void String String
  key :: ParsecT Void String Identity String
key = ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.alphaNumChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'_')

  qval :: MP.Parsec Void String String
  qval :: ParsecT Void String Identity String
qval = do
    Char
c <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.lookAhead ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.printChar
    case Char
c of
      Char
' '  -> String -> ParsecT Void String Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
      Char
'"'  -> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
c ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void String Identity String
val Char
c ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
c
      Char
'\'' -> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
c ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void String Identity String
val Char
c ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
c
      -- no quote, have to drop trailing spaces
      Char
_    -> (String -> String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        String -> String
dropSpace
        (ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void String Identity Char
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
MP.satisfy (\Token String
x -> Char -> Bool
isAlphaNum Char
Token String
x Bool -> Bool -> Bool
|| (Char
Token String
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'_', Char
'-', Char
'.']))) -- this is more lax than the spec
  val :: Char -> MP.Parsec Void String String
  val :: Char -> ParsecT Void String Identity String
val !Char
q = ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> ParsecT Void String Identity Char
qspecial Char
q ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.noneOf (Char -> String
specials Char
q)) -- noneOf may be too lax

  qspecial :: Char -> MP.Parsec Void String Char
  qspecial :: Char -> ParsecT Void String Identity Char
qspecial !Char
q =
    (String -> Char)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)
      (ParsecT Void String Identity String
 -> ParsecT Void String Identity Char)
-> (String -> ParsecT Void String Identity String)
-> String
-> ParsecT Void String Identity Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[ParsecT Void String Identity String]
xs -> [ParsecT Void String Identity String]
-> ParsecT Void String Identity String
forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice' [ParsecT Void String Identity String]
xs)
      ([ParsecT Void String Identity String]
 -> ParsecT Void String Identity String)
-> (String -> [ParsecT Void String Identity String])
-> String
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ParsecT Void String Identity String)
-> String -> [ParsecT Void String Identity String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
s -> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> (String -> ParsecT Void String Identity String)
-> String
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT Void String Identity String
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk (String -> ParsecT Void String Identity String)
-> String -> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ [Char
'\\', Char
s])
      (String -> ParsecT Void String Identity Char)
-> String -> ParsecT Void String Identity Char
forall a b. (a -> b) -> a -> b
$ (Char -> String
specials Char
q)

  specials :: Char -> [Char]
  specials :: Char -> String
specials !Char
q = [Char
q, Char
'\\', Char
'$', Char
'`']


parseUntil :: MP.Parsec Void String a -> MP.Parsec Void String String
parseUntil :: Parsec Void String a -> ParsecT Void String Identity String
parseUntil !Parsec Void String a
p = do
  (Parsec Void String a -> Parsec Void String a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Parsec Void String a -> Parsec Void String a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.lookAhead Parsec Void String a
p) Parsec Void String a
-> String -> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [])
    ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
          Char
c  <- ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
MP.anySingle
          String
c2 <- Parsec Void String a -> ParsecT Void String Identity String
forall a.
Parsec Void String a -> ParsecT Void String Identity String
parseUntil Parsec Void String a
p
          String -> ParsecT Void String Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char
c] String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
c2)
        )


-- | Parse one or more white spaces or tabs.
pWs :: MP.Parsec Void String ()
pWs :: ParsecT Void String Identity ()
pWs = ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
MP.satisfy (\Token String
x -> Char
Token String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
Token String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')) ParsecT Void String Identity String
-> () -> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()


-- | Try all parses in order, failing if all failed. Also fails
-- on empty list.
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
choice' :: [f a] -> f a
choice' = \case
  [] -> String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty list"
  [f a]
xs -> (f a -> f a -> f a) -> [f a] -> f a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\f a
x f a
y -> f a -> f a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try f a
x f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a -> f a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try f a
y) [f a]
xs