Use os-release package
This commit is contained in:
parent
3ddc719d8a
commit
9717a1c00f
|
|
@ -0,0 +1 @@
|
|||
*.golden -text
|
||||
|
|
@ -0,0 +1 @@
|
|||
dist-newstyle/
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
1.0.0
|
||||
=====
|
||||
|
||||
- Redo of the entire API
|
||||
|
||||
0.2.2
|
||||
=====
|
||||
|
||||
- Fixes builds failing just due to -Werror
|
||||
|
||||
- README.rst and ChangeLog.rst are distributed with cabal package
|
||||
|
||||
0.2.1
|
||||
=====
|
||||
|
||||
- Initial release
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
Copyright (c) 2014, Jan Matejka <yac@blesmrt.net>
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright notice,
|
||||
this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. Neither the name of the cbugzilla nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
||||
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
##########
|
||||
os-release
|
||||
##########
|
||||
|
||||
http://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
|
||||
Usage
|
||||
#####
|
||||
|
||||
.. code-block:: haskell
|
||||
|
||||
import System.OsRelease
|
||||
main = readOs >>= print
|
||||
|
||||
.. code-block::
|
||||
|
||||
Right (fromList [(OsReleaseKey "ANSI_COLOR",OsReleaseValue "1;32"),(OsReleaseKey "BUG_REPORT_URL",OsReleaseValue "https://bugs.gentoo.org/"),(OsReleaseKey "HOME_URL",OsReleaseValue "http://www.gentoo.org/"),(OsReleaseKey "ID",OsReleaseValue "gentoo"),(OsReleaseKey "NAME",OsReleaseValue "Gentoo"),(OsReleaseKey "PRETTY_NAME",OsReleaseValue "Gentoo/Linux"),(OsReleaseKey "SUPPORT_URL",OsReleaseValue "http://www.gentoo.org/main/en/support.xml")])
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
|
|
@ -0,0 +1,192 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
-- | A module to retrieve os-release information according to the
|
||||
-- freedesktop standard:
|
||||
-- https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
--
|
||||
-- Usage example:
|
||||
--
|
||||
-- @
|
||||
-- do
|
||||
-- Just (OsRelease {..}) <- fmap osRelease <$\> parseOsRelease
|
||||
-- putStrLn name
|
||||
-- @
|
||||
module System.OsRelease
|
||||
(
|
||||
-- * data types
|
||||
OsReleaseResult(..)
|
||||
, OsRelease(..)
|
||||
|
||||
-- * read/parse os-release
|
||||
, parseOsRelease
|
||||
, readOsRelease
|
||||
|
||||
-- * defaults
|
||||
, defaultOsRelease
|
||||
, defaultAssignments
|
||||
|
||||
-- * low-level
|
||||
, parseAssignments
|
||||
, parseAssignment
|
||||
, getAllAssignments
|
||||
, getOsRelease
|
||||
, parseOsRelease'
|
||||
)
|
||||
where
|
||||
|
||||
import System.OsRelease.Megaparsec
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Exception.Safe
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Void
|
||||
import GHC.Generics
|
||||
import Prelude hiding ( id
|
||||
)
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
data OsReleaseResult = OsReleaseResult {
|
||||
osRelease :: !OsRelease
|
||||
, unknown_fields :: [(String, String)]
|
||||
, parse_errors :: [MP.ParseError String Void]
|
||||
} deriving (Show)
|
||||
|
||||
|
||||
-- | All the explicitly documented fields of @os-release@.
|
||||
data OsRelease = OsRelease {
|
||||
name :: !(String)
|
||||
, version :: !(Maybe String)
|
||||
, id :: !(String)
|
||||
, id_like :: !(Maybe String)
|
||||
, version_codename :: !(Maybe String)
|
||||
, version_id :: !(Maybe String)
|
||||
, pretty_name :: !(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 (Generic, Show)
|
||||
|
||||
|
||||
class GetRecords a where
|
||||
getRecords :: a -> [String]
|
||||
|
||||
instance {-# OVERLAPPABLE #-} GetRecords (f p) => GetRecords (M1 i c f p) where
|
||||
getRecords (M1 x) = getRecords x
|
||||
|
||||
instance {-# OVERLAPPING #-} Selector c => GetRecords (M1 S c f p) where
|
||||
getRecords x = [selName x]
|
||||
|
||||
instance (GetRecords (a p), GetRecords (b p)) => GetRecords ((a :*: b) p) where
|
||||
getRecords (a :*: b) = getRecords a ++ getRecords b
|
||||
|
||||
|
||||
|
||||
-- | The defaults as per the spec:
|
||||
--
|
||||
-- @
|
||||
-- NAME=Linux
|
||||
-- ID=linux
|
||||
-- PRETTY_NAME=Linux
|
||||
-- @
|
||||
defaultOsRelease :: OsRelease
|
||||
defaultOsRelease = OsRelease { name = "Linux"
|
||||
, version = Nothing
|
||||
, id = "linux"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Linux"
|
||||
, 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
|
||||
}
|
||||
|
||||
-- | Like `defaultOsRelease`, except as key-value pair.
|
||||
defaultAssignments :: [(String, String)]
|
||||
defaultAssignments =
|
||||
[("NAME", "Linux"), ("ID", "linux"), ("PRETTY_NAME", "Linux")]
|
||||
|
||||
|
||||
-- | Get all allAssignments as @(key, val)@ from the @os-release@
|
||||
-- file contents.
|
||||
getAllAssignments :: String -- ^ file contents of os-release
|
||||
-> [Either (MP.ParseError String Void) (String, String)]
|
||||
getAllAssignments = fromRight [] . MP.parse parseAssignments "os-release"
|
||||
|
||||
|
||||
-- | Parse the assignments into `OsRelease`. This is merged with the
|
||||
-- defaults as per the spec. In case of no assignments, also returns
|
||||
-- the defaults.
|
||||
getOsRelease :: [(String, String)] -- ^ assignments
|
||||
-> OsRelease
|
||||
getOsRelease =
|
||||
(\case
|
||||
Error _ -> defaultOsRelease
|
||||
Success v -> v
|
||||
)
|
||||
. fromJSON
|
||||
. Object
|
||||
. (\x -> HM.union x (HM.fromList . aesonify $ defaultAssignments))
|
||||
. HM.fromList
|
||||
. aesonify
|
||||
where
|
||||
aesonify = 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 @IOError@ if both files could not be read.
|
||||
readOsRelease :: IO String
|
||||
readOsRelease = readFile "/etc/os-release" <|> readFile "/usr/lib/os-release"
|
||||
|
||||
|
||||
-- | Tries to read @\"\/etc\/os-release\"@ and @\"\/usr\/lib\/os_release\"@ in order
|
||||
-- and parses into `OsReleaseResult`. Returns @Nothing@ if both files could
|
||||
-- not be read.
|
||||
parseOsRelease :: IO (Maybe OsReleaseResult)
|
||||
parseOsRelease =
|
||||
handleIO (\_ -> pure Nothing) . fmap (Just . parseOsRelease') $ readOsRelease
|
||||
|
||||
|
||||
-- | Like `parseOsRelease`, except taking the input String explicitly.
|
||||
-- Primarily for tests.
|
||||
parseOsRelease' :: String -> OsReleaseResult
|
||||
parseOsRelease' s =
|
||||
let (errs, ass) = partitionEithers . getAllAssignments $ s
|
||||
osr = getOsRelease ass
|
||||
unknown_fields' =
|
||||
HM.toList
|
||||
. foldr (\x y -> HM.delete (fmap toUpper x) y) (HM.fromList ass)
|
||||
$ (init . getRecords . from $ defaultOsRelease)
|
||||
in OsReleaseResult osr unknown_fields' errs
|
||||
|
||||
|
||||
deriveJSON defaultOptions ''OsRelease
|
||||
|
|
@ -0,0 +1,102 @@
|
|||
{-# 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 =
|
||||
(\xs x -> join xs ++ x) <$> many (line MP.eol) <*> line MP.eof
|
||||
where
|
||||
line eol = choice'
|
||||
[ comment $> []
|
||||
, blank $> []
|
||||
, fmap
|
||||
(: [])
|
||||
( MP.withRecovery (\e -> parseUntil eol $> Left e)
|
||||
. fmap Right
|
||||
$ (parseAssignment <* eol)
|
||||
)
|
||||
]
|
||||
where
|
||||
comment = pWs *> MP.char '#' *> parseUntil eol *> eol
|
||||
blank = pWs *> 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 =
|
||||
(,) <$> (pWs *> key) <*> (MP.char '=' *> (MP.try qval <|> mempty) <* pWs)
|
||||
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.satisfy (\x -> isAlphaNum x || (x `elem` ['_', '-', '.']))) -- this is more lax than the spec
|
||||
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)
|
||||
. (\xs -> choice' xs)
|
||||
. fmap (\s -> MP.try . MP.chunk $ ['\\', s])
|
||||
$ (specials q)
|
||||
|
||||
specials :: Char -> [Char]
|
||||
specials !q = [q, '\\', '$', '`']
|
||||
|
||||
|
||||
parseUntil :: MP.Parsec Void String a -> MP.Parsec Void String String
|
||||
parseUntil !p = do
|
||||
(MP.try (MP.lookAhead p) $> [])
|
||||
<|> (do
|
||||
c <- MP.anySingle
|
||||
c2 <- parseUntil p
|
||||
pure ([c] `mappend` c2)
|
||||
)
|
||||
|
||||
|
||||
-- | Parse one or more white spaces or tabs.
|
||||
pWs :: MP.Parsec Void String ()
|
||||
pWs = many (MP.satisfy (\x -> x == ' ' || x == '\t')) $> ()
|
||||
|
||||
|
||||
-- | 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' = \case
|
||||
[] -> fail "Empty list"
|
||||
xs -> foldr1 (\x y -> MP.try x <|> MP.try y) xs
|
||||
|
|
@ -0,0 +1,131 @@
|
|||
cabal-version: 3.0
|
||||
author: Jan Matějka
|
||||
category: System
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
copyright: 2014 Jan Matějka <yac@blesmrt.net>
|
||||
license: BSD-3-Clause
|
||||
maintainer: Julian Ospald <hasufell@posteo.de>
|
||||
homepage: https://github.com/yaccz/os-release
|
||||
name: os-release
|
||||
synopsis: /etc/os-release helpers
|
||||
version: 1.0.0
|
||||
description:
|
||||
\/etc\/os-release helpers as per the freedesktop spec: https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
|
||||
extra-doc-files:
|
||||
ChangeLog.rst
|
||||
README.rst
|
||||
|
||||
extra-source-files: tests/Golden/data/*.golden tests/Golden/data/*.in
|
||||
|
||||
flag devel
|
||||
description: Enables -Werror
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/yaccz/os-release.git
|
||||
|
||||
common base
|
||||
build-depends: base >=4.11 && <5
|
||||
|
||||
common bytestring
|
||||
build-depends: bytestring
|
||||
|
||||
common aeson
|
||||
build-depends: aeson >=1.4
|
||||
|
||||
common filepath
|
||||
build-depends: filepath >=1.4.2.1
|
||||
|
||||
common hspec
|
||||
build-depends: hspec >=2.7.1
|
||||
|
||||
common hspec-megaparsec
|
||||
build-depends: hspec-megaparsec >=2.1.0
|
||||
|
||||
common megaparsec
|
||||
build-depends: megaparsec >=8.0.0
|
||||
|
||||
common pretty-simple
|
||||
build-depends: pretty-simple >=1.0.0.0
|
||||
|
||||
common safe-exceptions
|
||||
build-depends: safe-exceptions >=0.1.7.0
|
||||
|
||||
common tasty
|
||||
build-depends: tasty >=1.3
|
||||
|
||||
common tasty-golden
|
||||
build-depends: tasty-golden >=2.3.4
|
||||
|
||||
common tasty-hspec
|
||||
build-depends: tasty-hspec >=1.1.5.1
|
||||
|
||||
common text
|
||||
build-depends: text >=1.2
|
||||
|
||||
common unordered-containers
|
||||
build-depends: unordered-containers >=0.2.10.0
|
||||
|
||||
common config
|
||||
default-language: Haskell2010
|
||||
|
||||
if flag(devel)
|
||||
ghc-options:
|
||||
-Werror -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
else
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates
|
||||
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
LambdaCase
|
||||
OverloadedStrings
|
||||
QuasiQuotes
|
||||
TemplateHaskell
|
||||
TupleSections
|
||||
TypeFamilies
|
||||
|
||||
library
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, aeson
|
||||
, megaparsec
|
||||
, safe-exceptions
|
||||
, text
|
||||
, unordered-containers
|
||||
|
||||
exposed-modules: System.OsRelease
|
||||
other-modules: System.OsRelease.Megaparsec
|
||||
hs-source-dirs: library
|
||||
|
||||
test-suite tests
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, bytestring
|
||||
, filepath
|
||||
, hspec
|
||||
, hspec-megaparsec
|
||||
, megaparsec
|
||||
, pretty-simple
|
||||
, tasty
|
||||
, tasty-golden
|
||||
, tasty-hspec
|
||||
, text
|
||||
|
||||
build-depends: os-release
|
||||
hs-source-dirs: tests
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Golden.Real
|
||||
Specs.Megaparsec
|
||||
|
||||
type: exitcode-stdio-1.0
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Golden.Real where
|
||||
|
||||
import System.OsRelease
|
||||
|
||||
import System.FilePath
|
||||
import Text.Pretty.Simple
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Golden
|
||||
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.Text.Lazy as L
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
||||
|
||||
goldenTests :: IO TestTree
|
||||
goldenTests = do
|
||||
files <- findByExtension [".in"] (takeDirectory (__FILE__) </> "data")
|
||||
return $ testGroup
|
||||
"Parse os-release into OsRelease"
|
||||
(flip fmap files $ \file ->
|
||||
let out = replaceExtension file ".golden"
|
||||
in goldenVsString (takeBaseName file) out (parse file)
|
||||
)
|
||||
where
|
||||
parse f = do
|
||||
c <- readFile f
|
||||
pure
|
||||
. B.fromStrict
|
||||
. E.encodeUtf8
|
||||
. L.toStrict
|
||||
. pShowNoColor
|
||||
. parseOsRelease'
|
||||
$ c
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Alpine Linux"
|
||||
, version = Nothing
|
||||
, id = "alpine"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "3.11.3"
|
||||
, pretty_name = "Alpine Linux v3.11"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://alpinelinux.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugs.alpinelinux.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
NAME="Alpine Linux"
|
||||
ID=alpine
|
||||
VERSION_ID=3.11.3
|
||||
PRETTY_NAME="Alpine Linux v3.11"
|
||||
HOME_URL="https://alpinelinux.org/"
|
||||
BUG_REPORT_URL="https://bugs.alpinelinux.org/"
|
||||
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Arch Linux"
|
||||
, version = Nothing
|
||||
, id = "arch"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Arch Linux"
|
||||
, ansi_color = Just "38;2;23;147;209"
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.archlinux.org/"
|
||||
, documentation_url = Just "https://wiki.archlinux.org/"
|
||||
, support_url = Just "https://bbs.archlinux.org/"
|
||||
, bug_report_url = Just "https://bugs.archlinux.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Just "rolling"
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Just "archlinux"
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "LOGO"
|
||||
, "archlinux"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
NAME="Arch Linux"
|
||||
PRETTY_NAME="Arch Linux"
|
||||
ID=arch
|
||||
BUILD_ID=rolling
|
||||
ANSI_COLOR="38;2;23;147;209"
|
||||
HOME_URL="https://www.archlinux.org/"
|
||||
DOCUMENTATION_URL="https://wiki.archlinux.org/"
|
||||
SUPPORT_URL="https://bbs.archlinux.org/"
|
||||
BUG_REPORT_URL="https://bugs.archlinux.org/"
|
||||
LOGO=archlinux
|
||||
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "CentOS Linux"
|
||||
, version = Just "8 (Core)"
|
||||
, id = "centos"
|
||||
, id_like = Just "rhel fedora"
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "8"
|
||||
, pretty_name = "CentOS Linux 8 (Core)"
|
||||
, ansi_color = Just "0;31"
|
||||
, cpe_name = Just "cpe:/o:centos:centos:8"
|
||||
, home_url = Just "https://www.centos.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugs.centos.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "8"
|
||||
)
|
||||
,
|
||||
( "CENTOS_MANTISBT_PROJECT"
|
||||
, "CentOS-8"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "centos"
|
||||
)
|
||||
,
|
||||
( "PLATFORM_ID"
|
||||
, "platform:el8"
|
||||
)
|
||||
,
|
||||
( "CENTOS_MANTISBT_PROJECT_VERSION"
|
||||
, "8"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
NAME="CentOS Linux"
|
||||
VERSION="8 (Core)"
|
||||
ID="centos"
|
||||
ID_LIKE="rhel fedora"
|
||||
VERSION_ID="8"
|
||||
PLATFORM_ID="platform:el8"
|
||||
PRETTY_NAME="CentOS Linux 8 (Core)"
|
||||
ANSI_COLOR="0;31"
|
||||
CPE_NAME="cpe:/o:centos:centos:8"
|
||||
HOME_URL="https://www.centos.org/"
|
||||
BUG_REPORT_URL="https://bugs.centos.org/"
|
||||
|
||||
CENTOS_MANTISBT_PROJECT="CentOS-8"
|
||||
CENTOS_MANTISBT_PROJECT_VERSION="8"
|
||||
REDHAT_SUPPORT_PRODUCT="centos"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION="8"
|
||||
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Debian GNU/Linux"
|
||||
, version = Just "8 (jessie)"
|
||||
, id = "debian"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "8"
|
||||
, pretty_name = "Debian GNU/Linux 8 (jessie)"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "http://www.debian.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "http://www.debian.org/support/"
|
||||
, bug_report_url = Just "https://bugs.debian.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
PRETTY_NAME="Debian GNU/Linux 8 (jessie)"
|
||||
NAME="Debian GNU/Linux"
|
||||
VERSION_ID="8"
|
||||
VERSION="8 (jessie)"
|
||||
ID=debian
|
||||
HOME_URL="http://www.debian.org/"
|
||||
SUPPORT_URL="http://www.debian.org/support/"
|
||||
BUG_REPORT_URL="https://bugs.debian.org/"
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Linux"
|
||||
, version = Nothing
|
||||
, id = "linux"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Linux"
|
||||
, 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
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Exherbo"
|
||||
, version = Nothing
|
||||
, id = "exherbo"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Exherbo Linux"
|
||||
, ansi_color = Just "0;32"
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.exherbo.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "irc://irc.freenode.net/#exherbo"
|
||||
, bug_report_url = Just "https://bugs.exherbo.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
NAME="Exherbo"
|
||||
PRETTY_NAME="Exherbo Linux"
|
||||
ID="exherbo"
|
||||
# comment
|
||||
ANSI_COLOR="0;32"
|
||||
HOME_URL="https://www.exherbo.org/"
|
||||
SUPPORT_URL="irc://irc.freenode.net/#exherbo"
|
||||
BUG_REPORT_URL="https://bugs.exherbo.org/"
|
||||
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Fedora"
|
||||
, version = Just "31 (Container Image)"
|
||||
, id = "fedora"
|
||||
, id_like = Nothing
|
||||
, version_codename = Just ""
|
||||
, version_id = Just "31"
|
||||
, pretty_name = "Fedora 31 (Container Image)"
|
||||
, ansi_color = Just "0;34"
|
||||
, cpe_name = Just "cpe:/o:fedoraproject:fedora:31"
|
||||
, home_url = Just "https://fedoraproject.org/"
|
||||
, documentation_url = Just "https://docs.fedoraproject.org/en-US/fedora/f31/system-administrators-guide/"
|
||||
, support_url = Just "https://fedoraproject.org/wiki/Communicating_and_getting_help"
|
||||
, bug_report_url = Just "https://bugzilla.redhat.com/"
|
||||
, privacy_policy_url = Just "https://fedoraproject.org/wiki/Legal:PrivacyPolicy"
|
||||
, build_id = Nothing
|
||||
, variant = Just "Container Image"
|
||||
, variant_id = Just "container"
|
||||
, logo = Just "fedora-logo-icon"
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "31"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT"
|
||||
, "Fedora"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "Fedora"
|
||||
)
|
||||
,
|
||||
( "PLATFORM_ID"
|
||||
, "platform:f31"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
|
||||
, "31"
|
||||
)
|
||||
,
|
||||
( "LOGO"
|
||||
, "fedora-logo-icon"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
NAME=Fedora
|
||||
VERSION="31 (Container Image)"
|
||||
ID=fedora
|
||||
VERSION_ID=31
|
||||
VERSION_CODENAME=""
|
||||
PLATFORM_ID="platform:f31"
|
||||
PRETTY_NAME="Fedora 31 (Container Image)"
|
||||
ANSI_COLOR="0;34"
|
||||
LOGO=fedora-logo-icon
|
||||
CPE_NAME="cpe:/o:fedoraproject:fedora:31"
|
||||
HOME_URL="https://fedoraproject.org/"
|
||||
DOCUMENTATION_URL="https://docs.fedoraproject.org/en-US/fedora/f31/system-administrators-guide/"
|
||||
SUPPORT_URL="https://fedoraproject.org/wiki/Communicating_and_getting_help"
|
||||
BUG_REPORT_URL="https://bugzilla.redhat.com/"
|
||||
REDHAT_BUGZILLA_PRODUCT="Fedora"
|
||||
REDHAT_BUGZILLA_PRODUCT_VERSION=31
|
||||
REDHAT_SUPPORT_PRODUCT="Fedora"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION=31
|
||||
PRIVACY_POLICY_URL="https://fedoraproject.org/wiki/Legal:PrivacyPolicy"
|
||||
VARIANT="Container Image"
|
||||
VARIANT_ID=container
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Gentoo"
|
||||
, version = Nothing
|
||||
, id = "gentoo"
|
||||
, id_like = Nothing
|
||||
, version_codename = Nothing
|
||||
, version_id = Nothing
|
||||
, pretty_name = "Gentoo/Linux"
|
||||
, ansi_color = Just "1;32"
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.gentoo.org/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "https://www.gentoo.org/support/"
|
||||
, bug_report_url = Just "https://bugs.gentoo.org/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields = []
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
NAME=Gentoo
|
||||
ID=gentoo
|
||||
PRETTY_NAME="Gentoo/Linux"
|
||||
ANSI_COLOR="1;32"
|
||||
HOME_URL="https://www.gentoo.org/"
|
||||
SUPPORT_URL="https://www.gentoo.org/support/"
|
||||
BUG_REPORT_URL="https://bugs.gentoo.org/"
|
||||
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Linux Mint"
|
||||
, version = Just "18.2 (Sonya)"
|
||||
, id = "linuxmint"
|
||||
, id_like = Just "ubuntu"
|
||||
, version_codename = Just "sonya"
|
||||
, version_id = Just "18.2"
|
||||
, pretty_name = "Linux Mint 18.2"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "http://www.linuxmint.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "http://forums.linuxmint.com/"
|
||||
, bug_report_url = Just "http://bugs.launchpad.net/linuxmint/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "UBUNTU_CODENAME"
|
||||
, "xenial"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
NAME="Linux Mint"
|
||||
VERSION="18.2 (Sonya)"
|
||||
ID=linuxmint
|
||||
ID_LIKE=ubuntu
|
||||
PRETTY_NAME="Linux Mint 18.2"
|
||||
VERSION_ID="18.2"
|
||||
HOME_URL="http://www.linuxmint.com/"
|
||||
SUPPORT_URL="http://forums.linuxmint.com/"
|
||||
BUG_REPORT_URL="http://bugs.launchpad.net/linuxmint/"
|
||||
VERSION_CODENAME=sonya
|
||||
UBUNTU_CODENAME=xenial
|
||||
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Red Hat Enterprise Linux Server"
|
||||
, version = Just "7.6 (Maipo)"
|
||||
, id = "rhel"
|
||||
, id_like = Just "fedora"
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "7.6"
|
||||
, pretty_name = "Red Hat Enterprise Linux"
|
||||
, ansi_color = Just "0;31"
|
||||
, cpe_name = Just "cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
, home_url = Just "https://www.redhat.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugzilla.redhat.com/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Just "Server"
|
||||
, variant_id = Just "server"
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT"
|
||||
, "Red Hat Enterprise Linux 7"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "Red Hat Enterprise Linux"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
NAME="Red Hat Enterprise Linux Server"
|
||||
VERSION="7.6 (Maipo)"
|
||||
ID="rhel"
|
||||
ID_LIKE="fedora"
|
||||
VARIANT="Server"
|
||||
VARIANT_ID="server"
|
||||
VERSION_ID="7.6"
|
||||
PRETTY_NAME="Red Hat Enterprise Linux"
|
||||
ANSI_COLOR="0;31"
|
||||
CPE_NAME="cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
HOME_URL="https://www.redhat.com/"
|
||||
BUG_REPORT_URL="https://bugzilla.redhat.com/"
|
||||
|
||||
REDHAT_BUGZILLA_PRODUCT="Red Hat Enterprise Linux 7"
|
||||
REDHAT_BUGZILLA_PRODUCT_VERSION=7.6
|
||||
REDHAT_SUPPORT_PRODUCT="Red Hat Enterprise Linux"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION="7.6"
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Red Hat Enterprise Linux Server"
|
||||
, version = Just "7.6 (Maipo)"
|
||||
, id = "rhel"
|
||||
, id_like = Just "fedora"
|
||||
, version_codename = Nothing
|
||||
, version_id = Just "7.6"
|
||||
, pretty_name = "Red Hat Enterprise Linux"
|
||||
, ansi_color = Just "0;31"
|
||||
, cpe_name = Just "cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
, home_url = Just "https://www.redhat.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Nothing
|
||||
, bug_report_url = Just "https://bugzilla.redhat.com/"
|
||||
, privacy_policy_url = Nothing
|
||||
, build_id = Nothing
|
||||
, variant = Just "Server"
|
||||
, variant_id = Just "server"
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "REDHAT_SUPPORT_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT"
|
||||
, "Red Hat Enterprise Linux 7"
|
||||
)
|
||||
,
|
||||
( "REDHAT_SUPPORT_PRODUCT"
|
||||
, "Red Hat Enterprise Linux"
|
||||
)
|
||||
,
|
||||
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
|
||||
, "7.6"
|
||||
)
|
||||
]
|
||||
, parse_errors =
|
||||
[ TrivialError 520
|
||||
( Just
|
||||
( Tokens ( '\'' :| "" ) )
|
||||
)
|
||||
( fromList
|
||||
[ Label ( 'e' :| "nd of line" ) ]
|
||||
)
|
||||
]
|
||||
}
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
NAME="Red Hat Enterprise Linux Server"
|
||||
VERSION="7.6 (Maipo)"
|
||||
ID="rhel"
|
||||
ID_LIKE="fedora"
|
||||
VARIANT="Server"
|
||||
VARIANT_ID="server"
|
||||
VERSION_ID="7.6"
|
||||
PRETTY_NAME="Red Hat Enterprise Linux"
|
||||
ANSI_COLOR="0;31"
|
||||
CPE_NAME="cpe:/o:redhat:enterprise_linux:7.6:GA:server"
|
||||
HOME_URL="https://www.redhat.com/"
|
||||
BUG_REPORT_URL="https://bugzilla.redhat.com/"
|
||||
|
||||
REDHAT_BUGZILLA_PRODUCT="Red Hat Enterprise Linux 7"
|
||||
REDHAT_BUGZILLA_PRODUCT_VERSION=7.6
|
||||
REDHAT_SUPPORT_PRODUCT="Red Hat Enterprise Linux"
|
||||
REDHAT_SUPPORT_PRODUCT_VERSION="7.6"
|
||||
foo=1.'
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
OsReleaseResult
|
||||
{ osRelease = OsRelease
|
||||
{ name = "Ubuntu"
|
||||
, version = Just "20.04 LTS (Focal Fossa)"
|
||||
, id = "ubuntu"
|
||||
, id_like = Just "debian"
|
||||
, version_codename = Just "focal"
|
||||
, version_id = Just "20.04"
|
||||
, pretty_name = "Ubuntu 20.04 LTS"
|
||||
, ansi_color = Nothing
|
||||
, cpe_name = Nothing
|
||||
, home_url = Just "https://www.ubuntu.com/"
|
||||
, documentation_url = Nothing
|
||||
, support_url = Just "https://help.ubuntu.com/"
|
||||
, bug_report_url = Just "https://bugs.launchpad.net/ubuntu/"
|
||||
, privacy_policy_url = Just "https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
|
||||
, build_id = Nothing
|
||||
, variant = Nothing
|
||||
, variant_id = Nothing
|
||||
, logo = Nothing
|
||||
}
|
||||
, unknown_fields =
|
||||
[
|
||||
( "UBUNTU_CODENAME"
|
||||
, "focal"
|
||||
)
|
||||
]
|
||||
, parse_errors = []
|
||||
}
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
NAME="Ubuntu"
|
||||
VERSION="20.04 LTS (Focal Fossa)"
|
||||
ID=ubuntu
|
||||
ID_LIKE=debian
|
||||
PRETTY_NAME="Ubuntu 20.04 LTS"
|
||||
VERSION_ID="20.04"
|
||||
HOME_URL="https://www.ubuntu.com/"
|
||||
SUPPORT_URL="https://help.ubuntu.com/"
|
||||
BUG_REPORT_URL="https://bugs.launchpad.net/ubuntu/"
|
||||
PRIVACY_POLICY_URL="https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
|
||||
VERSION_CODENAME=focal
|
||||
UBUNTU_CODENAME=focal
|
||||
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
import Golden.Real
|
||||
import Specs.Megaparsec
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hspec
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
ms <- testSpec "megaparsec spec" megaparsecSpec
|
||||
gs <- goldenTests
|
||||
defaultMain (tests [ms, gs])
|
||||
|
||||
tests :: [TestTree] -> TestTree
|
||||
tests ts = testGroup "Tests" (ts++[])
|
||||
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
module Specs.Megaparsec where
|
||||
|
||||
import System.OsRelease
|
||||
|
||||
import Data.Either
|
||||
import Data.Void
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Megaparsec
|
||||
|
||||
import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
megaparsecSpec :: Spec
|
||||
megaparsecSpec = do
|
||||
describe "parseAssignment" $ do
|
||||
it "parses simple value" $ shouldParse' "foo=bar" ("foo", "bar")
|
||||
it "parses single quoted value" $ shouldParse' "foo='bar'" ("foo", "bar")
|
||||
it "parses double quoted value" $ shouldParse' "foo=\"bar\"" ("foo", "bar")
|
||||
|
||||
it "parses _ var" $ shouldParse' "f_x=''" ("f_x", "")
|
||||
|
||||
-- this is not valid per spec, but many files do this
|
||||
it "parses ._- in unquoted assignment"
|
||||
$ shouldParse' "VERSION_ID=bar-1.9_rc2" ("VERSION_ID", "bar-1.9_rc2")
|
||||
|
||||
it "parses quoted space" $ shouldParse' "f='a b'" ("f", "a b")
|
||||
it "parses quoted -" $ shouldParse' "f='a-b'" ("f", "a-b")
|
||||
|
||||
it "parses special \\" $ shouldParse' "foo='ba\\\\r'" ("foo", "ba\\r")
|
||||
it "parses special `" $ shouldParse' "foo='ba\\`r'" ("foo", "ba`r")
|
||||
it "parses special '" $ shouldParse' "foo='ba\\'r'" ("foo", "ba'r")
|
||||
it "parses special $" $ shouldParse' "foo='ba\\$r'" ("foo", "ba$r")
|
||||
it "parses special \"" $ shouldParse' "foo=\"ba\\\"r\"" ("foo", "ba\"r")
|
||||
|
||||
it "parses empty val noquotes" $ shouldParse' "foo=" ("foo", "")
|
||||
it "parses empty val quote \"" $ shouldParse' "foo=\"\"" ("foo", "")
|
||||
it "parses empty val quote '" $ shouldParse' "foo=''" ("foo", "")
|
||||
|
||||
it "breaks on comments" $ shouldFail' "# foo=\"bar'"
|
||||
it "breaks on misquoting 1" $ shouldFail' "foo=\"bar'"
|
||||
it "breaks on misquoting 2" $ shouldFail' "foo='bar\""
|
||||
it "breaks on unquoted $" $ shouldFail' "foo='ba$r'"
|
||||
it "breaks on unquoted `" $ shouldFail' "foo='ba`r'"
|
||||
it "breaks on unquoted \"" $ shouldFail' "foo=\"ba\"r\""
|
||||
it "breaks on unquoted '" $ shouldFail' "foo='ba'r'"
|
||||
it "breaks on unquoted \\" $ shouldFail' "foo='ba\\r'"
|
||||
it "breaks on unquoted val with space" $ shouldFail' "foo=ba r"
|
||||
it "breaks on unquoted val with ;" $ shouldFail' "foo=ba;r"
|
||||
it "breaks on unquoted val with \\" $ shouldFail' "foo=ba\\r"
|
||||
it "breaks on trailing NL" $ shouldFail' "foo=bar\n"
|
||||
|
||||
|
||||
describe "parseAssignments" $ do
|
||||
it "parses simple values" $ shouldParseMany "foo=bar" [("foo", "bar")]
|
||||
|
||||
it "parses multiple values"
|
||||
$ shouldParseMany "foo=bar\nbar=baz" [("foo", "bar"), ("bar", "baz")]
|
||||
it "parses multiple values with comments" $ shouldParseMany
|
||||
"foo=bar\n# comment\nbar=baz"
|
||||
[("foo", "bar"), ("bar", "baz")]
|
||||
|
||||
it "parses gracefully" $ shouldParseMany "foo=bar\nbar=baz\"" [("foo", "bar")]
|
||||
|
||||
it "parses empty files" $ shouldParseMany "" []
|
||||
it "parses empty files with newlines" $ shouldParseMany "\n\n" []
|
||||
it "parses empty files with newlines and comments"
|
||||
$ shouldParseMany "\n\n#\n" []
|
||||
|
||||
it "parses comments with leading spaces" $ shouldParseMany " #" []
|
||||
|
||||
parse :: String -> Either (MP.ParseErrorBundle String Void) (String, String)
|
||||
parse = MP.parse (parseAssignment <* MP.eof) ""
|
||||
|
||||
shouldParse' :: String -> (String, String) -> Expectation
|
||||
shouldParse' s s' = parse s `shouldParse` s'
|
||||
|
||||
shouldFail' :: String -> Expectation
|
||||
shouldFail' s = parse `shouldFailOn` s
|
||||
|
||||
parseMany :: String
|
||||
-> Either (MP.ParseErrorBundle String Void) [(String, String)]
|
||||
parseMany = fmap rights . MP.parse parseAssignments ""
|
||||
|
||||
shouldParseMany :: String -> [(String, String)] -> Expectation
|
||||
shouldParseMany s s' = parseMany s `shouldParse` s'
|
||||
|
||||
shouldFailMany :: String -> Expectation
|
||||
shouldFailMany s = parseMany `shouldFailOn` s
|
||||
|
|
@ -173,6 +173,9 @@ common time
|
|||
common transformers
|
||||
build-depends: transformers >=0.5
|
||||
|
||||
common os-release
|
||||
build-depends: os-release >=1.0.0
|
||||
|
||||
common unix
|
||||
build-depends: unix >=2.7
|
||||
|
||||
|
|
@ -261,6 +264,7 @@ library
|
|||
, text
|
||||
, time
|
||||
, transformers
|
||||
, os-release
|
||||
, unix
|
||||
, unix-bytestring
|
||||
, unordered-containers
|
||||
|
|
@ -285,7 +289,6 @@ library
|
|||
GHCup.Types.JSON
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.OsRelease
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Utils.File
|
||||
GHCup.Utils.Logger
|
||||
|
|
|
|||
|
|
@ -12,7 +12,6 @@ module GHCup.Platform where
|
|||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON ( )
|
||||
import GHCup.Utils.OsRelease
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
|
@ -36,6 +35,7 @@ import Prelude hiding ( abs
|
|||
, writeFile
|
||||
)
|
||||
import System.Info
|
||||
import System.OsRelease
|
||||
import Text.Regex.Posix
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -148,8 +148,9 @@ getLinuxDistro = do
|
|||
|
||||
try_os_release :: IO (Text, Maybe Text)
|
||||
try_os_release = do
|
||||
OsRelease { name = Just n, version_id = v } <- parseOsRelease
|
||||
pure (T.pack n, fmap T.pack v)
|
||||
Just (OsRelease { name = name, version_id = version_id }) <-
|
||||
fmap osRelease <$> parseOsRelease
|
||||
pure (T.pack name, fmap T.pack version_id)
|
||||
|
||||
try_lsb_release_cmd :: IO (Text, Maybe Text)
|
||||
try_lsb_release_cmd = do
|
||||
|
|
|
|||
|
|
@ -1,164 +0,0 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
-- | A module to retrieve os-release information according to the
|
||||
-- freedesktop standard:
|
||||
-- https://www.freedesktop.org/software/systemd/man/os-release.html
|
||||
--
|
||||
-- Some of it is stolen from:
|
||||
-- https://hackage.haskell.org/package/os-release-0.2.2/docs/src/System-OsRelease.html
|
||||
module GHCup.Utils.OsRelease where
|
||||
|
||||
import GHCup.Utils.MegaParsec
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Void
|
||||
import HPath
|
||||
import HPath.IO
|
||||
import Prelude hiding ( abs
|
||||
, readFile
|
||||
)
|
||||
|
||||
import qualified Data.ByteString.Lazy.UTF8 as UTF8
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MP
|
||||
|
||||
|
||||
-- | 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
|
||||
Loading…
Reference in New Issue