jan-matejka / os-release Goto Github PK

-- | All the explicitly documented fields of `os-release`.
data OsRelease = OsRelease {
    name :: Maybe String
  , version :: Maybe String
  , id :: Maybe String
  , id_like :: Maybe String
  , version_codename :: Maybe String
  , version_id :: Maybe String
  , pretty_name :: Maybe String
  , ansi_color :: Maybe String
  , cpe_name :: Maybe String
  , home_url :: Maybe String
  , documentation_url :: Maybe String
  , support_url :: Maybe String
  , bug_report_url :: Maybe String
  , privacy_policy_url :: Maybe String
  , build_id :: Maybe String
  , variant :: Maybe String
  , variant_id :: Maybe String
  , logo :: Maybe String
} deriving (Show)

emptyOsRelease :: OsRelease
emptyOsRelease = OsRelease { name               = Nothing
                           , version            = Nothing
                           , id                 = Nothing
                           , id_like            = Nothing
                           , version_codename   = Nothing
                           , version_id         = Nothing
                           , pretty_name        = Nothing
                           , ansi_color         = Nothing
                           , cpe_name           = Nothing
                           , home_url           = Nothing
                           , documentation_url  = Nothing
                           , support_url        = Nothing
                           , bug_report_url     = Nothing
                           , privacy_policy_url = Nothing
                           , build_id           = Nothing
                           , variant            = Nothing
                           , variant_id         = Nothing
                           , logo               = Nothing
                           }

-- | Parse a single line assignment and extract the right hand side.
-- This is only a subset of a shell parser, see
-- https://www.freedesktop.org/software/systemd/man/os-release.html
parseAssignment :: MP.Parsec Void String (String, String)
parseAssignment =
  (,)
    <$> (MP.space *> key)
    <*> (MP.char '=' *> (MP.try qval <|> mempty) <* MP.space <* MP.eof)
 where
  dropSpace :: String -> String
  dropSpace = reverse . dropWhile (\x -> x == ' ' || x == '\t') . reverse

  key :: MP.Parsec Void String String
  key = some (MP.try MP.alphaNumChar <|> MP.char '_')

  qval :: MP.Parsec Void String String
  qval = do
    c <- MP.lookAhead MP.printChar
    case c of
      ' '  -> pure ""
      '"'  -> MP.char c *> val c <* MP.char c
      '\'' -> MP.char c *> val c <* MP.char c
      -- no quote, have to drop trailing spaces
      _    -> fmap dropSpace (some MP.alphaNumChar)
  val :: Char -> MP.Parsec Void String String
  val q = many (qspecial q <|> MP.noneOf (specials q)) -- noneOf may be too lax

  qspecial :: Char -> MP.Parsec Void String Char
  qspecial q =
    fmap (!! 1)
      . choice'
      . fmap (\s -> MP.try . MP.chunk $ ['\\', s])
      $ (specials q)

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


-- | Get all allAssignments as `(key, val)` from the `os-release`
-- file contents.
allAssignments :: String  -- ^ file contents of os-release
               -> [(String, String)]
allAssignments = rights . fmap (MP.parse parseAssignment "") . lines


-- | Parse the assignments into OsRelease.
--
-- This can't fail and will create an "empty" product type instead on
-- failure.
osRelease :: [(String, String)]  -- ^ assignments
          -> OsRelease
osRelease =
  (\case
      Error   _ -> emptyOsRelease
      Success v -> v
    )
    . fromJSON
    . Object
    . HM.fromList
    . fmap (\(k, v) -> (T.toLower . T.pack $ k, String . T.pack $ v))


-- | Tries to read `/etc/os-release` and `/usr/lib/os_release` in order.
-- Throws an exception if both files do not exist.
readOsRelease :: IO String
readOsRelease = do
  let os_release1 :: Path Abs
      os_release1 = [abs|/etc/os-release|]
  let os_release2 :: Path Abs
      os_release2 = [abs|/usr/lib/os-release|]

  bs <- readFile os_release1 <|> readFile os_release2
  -- os-release is utf8
  pure . UTF8.toString $ bs


-- | Tries to read `/etc/os-release` and `/usr/lib/os_release` in order
-- and parses into `OsRelease`. Throws an exception if both files do not
-- exist.
parseOsRelease :: IO OsRelease
parseOsRelease = fmap (osRelease . allAssignments) readOsRelease


deriveJSON defaultOptions ''OsRelease