os-release 0.1.0 → 0.2.0
raw patch · 6 files changed
+207/−30 lines, 6 filesdep +containersdep +parsecdep +temporary
Dependencies added: containers, parsec, temporary, transformers
Files
- library/System/OsRelease.hs +101/−13
- os-release.cabal +12/−3
- tests/OsReleaseSpec.hs +0/−13
- tests/Spec.hs +0/−1
- tests/unit/OsReleaseSpec.hs +93/−0
- tests/unit/Spec.hs +1/−0
library/System/OsRelease.hs view
@@ -1,19 +1,107 @@+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+ module System.OsRelease- ( detect- , OsRelease (..)- , detect'+ ( parseOs+ , readOs+ , readOs'+ , OsReleaseValue (..)+ , OsReleaseKey (..)+ , OsReleaseLine+ , OsRelease ) where -data OsRelease = OpenSUSE- deriving (Eq, Show)+import Text.ParserCombinators.Parsec+import Text.Parsec.Prim hiding (try)+import Data.Map.Lazy hiding (foldl)+import Data.Functor.Identity+import Data.String+import Data.Monoid+import Data.Either+import Control.Applicative ((<$>))+import Control.Monad+import qualified Control.Exception as E -detect :: IO (Maybe OsRelease)-detect = do- osr <- readFile "/etc/os-release"- return . detect' $ lines osr+type OsReleaseLine = (OsReleaseKey, OsReleaseValue)+newtype OsReleaseKey = OsReleaseKey String+ deriving (Ord, Eq, IsString, Show) -detect' :: [String] -> Maybe OsRelease-detect' [] = Nothing-detect' ("NAME=openSUSE":_) = Just OpenSUSE-detect' (_:xs) = detect' xs+newtype OsReleaseValue = OsReleaseValue String+ deriving (IsString, Eq, Show)++type OsRelease = Map OsReleaseKey OsReleaseValue++class Parsable a where+ parser :: ParsecT String () Identity a++instance Parsable OsReleaseKey where+ parser = OsReleaseKey <$> many1 (alphaNum <|> char '_')++instance Parsable OsReleaseValue where+ parser = OsReleaseValue <$> (qVal <|> nqVal)+ where+ qVal :: Parser String+ qVal = do+ quote <- oneOf "'\""+ value <- manyTill (qValInside quote) (char quote)+ noJunk+ return (foldl mappend "" value)++ noJunk = try . lookAhead $ eof <|> (void newline)++ qValInside :: Char -> ParsecT String () Identity String+ qValInside quote = (qSpecial quote) <|> (:[]) <$> (noneOf $ specials quote)++ qSpecial :: Char -> ParsecT String () Identity String+ qSpecial quote = (\x -> [x!!1]) <$>+ foldl1 (<|>) [try (string $ "\\" <> [x]) | x <- specials quote]++ specials :: Char -> [Char]+ specials quote =+ [ quote+ , '\\'+ , '$'+ , '`'+ ]++ nqVal :: Parser String+ nqVal = do+ x <- many alphaNum+ noJunk+ return x++instance Parsable OsReleaseLine where+ parser = do+ var <- parser :: ParsecT String () Identity OsReleaseKey+ _ <- char '='+ val <- parser :: ParsecT String () Identity OsReleaseValue+ return (var, val)++instance Parsable OsRelease where+ parser = fromList <$> (sepEndBy (parser :: ParsecT String () Identity OsReleaseLine) newline)+++readOs :: IO (Either OsReleaseError OsRelease)+readOs = do+ xs <- readOs' ["/etc/os-release", "/usr/lib/os-release"]+ case xs of+ Left e -> return $ Left e+ Right x -> return . h $ parseOs x+ where+ h (Left e) = Left $ OsReleaseParseError e+ h (Right x) = Right x++data OsReleaseError = OsReleaseError String+ | OsReleaseParseError ParseError+ deriving (Show)++readOs' :: [FilePath] -> IO (Either OsReleaseError String)+readOs' fs = do+ xs <- mapM (E.try . readFile) fs :: IO [Either E.IOException String]+ return . h $ rights xs+ where+ h [] = Left . OsReleaseError $ "Neither of " <> unwords fs <> " could be read"+ h (x:_) = Right x++parseOs :: String -> Either ParseError OsRelease+parseOs xs = parse (parser :: ParsecT String () Identity OsRelease) "os-release" xs
os-release.cabal view
@@ -9,7 +9,7 @@ homepage: https://github.com/yaccz/os-release name: os-release synopsis: /etc/os-release helpers-version: 0.1.0+version: 0.2.0 description: /etc/os-release helpers @@ -19,7 +19,12 @@ library build-depends:- base < 5+ base < 5+ , parsec+ , containers+ , parsec+ , containers+ , transformers default-language: Haskell2010 exposed-modules: System.OsRelease ghc-options:@@ -34,6 +39,10 @@ base < 5 , os-release , hspec+ , parsec+ , containers+ , transformers+ , temporary default-language: Haskell2010 ghc-options:@@ -41,7 +50,7 @@ -Werror hs-source-dirs: library- tests+ tests/unit main-is: Spec.hs other-modules:
− tests/OsReleaseSpec.hs
@@ -1,13 +0,0 @@-module OsReleaseSpec (spec) where--import Test.Hspec-import System.OsRelease--spec :: Spec-spec = do- describe "detect" $ do- it "parses" $ do- detect' ["NAME=openSUSE"] `shouldBe` Just OpenSUSE- detect' [] `shouldBe` Nothing- detect' ["NAME=open"] `shouldBe` Nothing- detect' ["NAME=\"openSUSE\""] `shouldBe` Nothing
− tests/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/unit/OsReleaseSpec.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}+module OsReleaseSpec (spec) where++import Test.Hspec+import System.OsRelease+import Data.Map.Lazy+import Data.Monoid+import OsReleaseSpec.Reals+import System.IO.Temp+import System.IO++spec :: Spec+spec = do+ describe "parseOs" $ do+ it "parses simple value" $ fooBar "foo=bar"+ it "parses simple value with trailing NL" $ fooBar "foo=bar\n"+ it "parses single quoted value" $ fooBar "foo='bar'"+ it "parses double quoted value" $ fooBar "foo=\"bar\""++ it "parses _ var" $ parseCase "f_x=''" [("f_x", "")]++ it "parses quoted space" $ parseCase "f='a b'" [("f", "a b")]+ it "parses quoted -" $ parseCase "f='a-b'" [("f", "a-b")]++ it "parses special \\" $ specialFooBar "foo='ba\\\\r'" "\\"+ it "parses special `" $ specialFooBar "foo='ba\\`r'" "`"+ it "parses special '" $ specialFooBar "foo='ba\\'r'" "'"+ it "parses special $" $ specialFooBar "foo='ba\\$r'" "$"+ it "parses special \"" $ specialFooBar "foo=\"ba\\\"r\"" "\""++ it "parses multiple values" $ parseCase+ "foo=bar\nqux=quux"+ [("foo", "bar"), ("qux", "quux")]++ it "parses empty val noquotes" $ parseCase "foo=" [("foo", "")]+ it "parses empty val quote \"" $ parseCase "foo=\"\"" [("foo", "")]+ it "parses empty val quote '" $ parseCase "foo=''" [("foo", "")]++ it "breaks on misquoting 1" $ errCase "foo=\"bar'"+ it "breaks on misquoting 2" $ errCase "foo='bar\""+ it "breaks on unquoted $" $ errCase "foo='ba$r'"+ it "breaks on unquoted `" $ errCase "foo='ba`r'"+ it "breaks on unquoted \"" $ errCase "foo=\"ba\"r\""+ it "breaks on unquoted '" $ errCase "foo='ba'r'"+ it "breaks on unquoted \\" $ errCase "foo='ba\\r'"+ it "breaks on unquoted val with space" $ errCase "foo=ba r"+ it "breaks on unquoted val with ;" $ errCase "foo=ba;r"+ it "breaks on unquoted val with \\" $ errCase "foo=ba\\r"++ it "parses Gentoo os-release" $ realCase Gentoo+ it "parses OpenSUSE Factory os-release" $ realCase OpenSUSEFactory+ it "parses Arch os-release" $ realCase Arch++ describe "readOs'" $ do+ it "reads 1st" $ do+ withSystemTempFile "1st.txt" $ \f1 hf1 -> do+ withSystemTempFile "2nd.txt" $ \f2 hf2 -> do+ hPutStr hf1 "1"+ hPutStr hf2 "2"+ mapM_ hClose [hf1, hf2]++ xs <- readOs' [f1, f2]+ case xs of+ Right x -> x `shouldBe` "1"+ Left e -> expectationFailure $ show e++ it "reads 2nd" $ do+ withSystemTempFile "a-file.txt" $ \f h -> do+ hPutStr h "1"+ hClose h++ xs <- readOs' ["/oh-well-let's-hope-no-one-makes-this-file", f]+ case xs of+ Right x -> x `shouldBe` "1"+ Left e -> expectationFailure $ show e++ where+ fooBar x = parseCase x [("foo", "bar")]++ specialFooBar :: String -> String -> Expectation+ specialFooBar x y = parseCase x [("foo", OsReleaseValue $ "ba" <> y <> "r")]++ realCase x = parseCase (input x) (output x)++ parseCase x y =+ case parseOs x of+ Left e -> expectationFailure $ show e+ Right z -> z `shouldBe` (fromList y)++ errCase x =+ case parseOs x of+ Left _ -> ("1"::String) `shouldBe` "1"+ Right z -> expectationFailure (show z)
+ tests/unit/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}