scfg (empty) → 1.0.0
raw patch · 9 files changed
+513/−0 lines, 9 filesdep +basedep +hspecdep +megaparsec
Dependencies added: base, hspec, megaparsec, temporary, text
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- README.md +54/−0
- scfg.cabal +61/−0
- src/Data/Scfg.hs +42/−0
- src/Data/Scfg/Formatter.hs +41/−0
- src/Data/Scfg/Parser.hs +85/−0
- src/Data/Scfg/Types.hs +40/−0
- test/Test.hs +165/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog++## 1.0.0++Initial release.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2026 Marius Lysakerrud++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,54 @@+# haskell-scfg++[](https://builds.sr.ht/~mariusl/haskell-scfg?)++Haskell library for [scfg](https://codeberg.org/emersion/scfg).++## Usage++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Data.Scfg (+ Directive (directiveChildren, directiveName, directiveParams),+ ParseError (errorMessage),+ parse,+ )+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO++config :: Text+config =+ "train \"Shinkansen\" {\n\+ \ model \"E5\" {\n\+ \ max-speed 320km/h\n\+ \ weight 453.5t\n\+ \ lines-served \"Tōhoku\" \"Hokkaido\"\n\+ \ }\n\+ \ model \"E7\" {\n\+ \ max-speed 275km/h\n\+ \ weight 540t\n\+ \ lines-served \"Hokuriku\" \"Jōetsu\"\n\+ \ }\n\+ \}\n"++main :: IO ()+main = case parse config of+ Left err -> TIO.putStrLn $ "parse error: " <> errorMessage err+ Right cfg -> do+ let models = concatMap directiveChildren cfg+ mapM_ (\m -> TIO.putStrLn $ T.unwords (directiveName m : directiveParams m)) models++```++## Contributing++Feel free to send patches to my+[public-inbox](https://lists.sr.ht/~mariusl/public-inbox). Please note+what change the patch will have on the version in accordance with the+[Haskell Package Versioning Policy (PVP)](https://pvp.haskell.org/).++## License++MIT
+ scfg.cabal view
@@ -0,0 +1,61 @@+cabal-version: 3.0+name: scfg+version: 1.0.0+synopsis: SCFG parser for Haskell+description:+ A simple parser for SCFG (simple configuration format) files++author: Marius Lysakerrud+maintainer: mail@marius.pm+license: MIT+license-file: LICENSE+homepage: https://git.sr.ht/~mariusl/haskell-scfg+bug-reports: https://lists.sr.ht/~mariusl/public-inbox+category: Data+build-type: Simple+tested-with: GHC ==9.8.2 || ==9.10.3+extra-doc-files:+ CHANGELOG.md+ README.md++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules:+ Data.Scfg+ Data.Scfg.Formatter+ Data.Scfg.Types++ other-modules: Data.Scfg.Parser+ build-depends:+ , base >=4.19.0.0 && <4.21+ , megaparsec >=9.7.0 && <9.8+ , text >=2.1.0 && <2.2++ hs-source-dirs: src+ default-language: Haskell2010++test-suite scfg-test+ import: warnings+ default-language: Haskell2010+ other-modules:+ Data.Scfg+ Data.Scfg.Formatter+ Data.Scfg.Parser+ Data.Scfg.Types++ type: exitcode-stdio-1.0+ hs-source-dirs: test src+ main-is: Test.hs+ build-depends:+ , base >=4.19.0.0 && <4.21+ , hspec >=2.11.0 && <2.12+ , megaparsec >=9.7.0 && <9.8+ , temporary >=1.3 && <1.4+ , text >=2.1.0 && <2.2++source-repository head+ type: git+ location: https://git.sr.ht/~mariusl/haskell-scfg
+ src/Data/Scfg.hs view
@@ -0,0 +1,42 @@+{- | Parser for the [scfg](https://codeberg.org/emersion/scfg)+configuration file format.+-}+module Data.Scfg (+ parse,+ parseFile,+ format,+ formatFile,+ Directive (..),+ Config,+ ParseError (..),+) where++import qualified Data.Scfg.Formatter as F+import qualified Data.Scfg.Parser as P+import Data.Scfg.Types+import Data.Text (Text)+import qualified Data.Text.IO as TIO++{- | Parse scfg from 'Text'. Returns a 'Data.Scfg.Types.ParseError' if+the input is not valid scfg.+-}+parse :: Text -> Either ParseError Config+parse = P.parseConfig++{- | Parse scfg from a file. Returns a 'Data.Scfg.Types.ParseError' if+the input is not valid scfg or if the file cannot be read.+-}+parseFile :: FilePath -> IO (Either ParseError Config)+parseFile path = parse <$> TIO.readFile path++{- | Format a 'Config' as a canonical 'Text' representation. All words+are double-quoted and blocks indented with tabs.+-}+format :: Config -> Text+format = F.format++{- | Format a 'Config' and write it to a file. Returns an 'IOError' if+the file cannot be written.+-}+formatFile :: FilePath -> Config -> IO ()+formatFile path = TIO.writeFile path . F.format
+ src/Data/Scfg/Formatter.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Canonical formatter for scfg configurations.+module Data.Scfg.Formatter (format) where++import Data.Scfg.Types+import Data.Text (Text)+import qualified Data.Text as T++{- | Format a 'Config' as canonical scfg text. All words are+double-quoted and blocks are indented with tabs.+-}+format :: [Directive] -> Text+format = foldMap (formatDirective 0)++formatDirective :: Int -> Directive -> Text+formatDirective depth d =+ indent+ <> quoteWord (directiveName d)+ <> params+ <> block+ <> "\n"+ where+ indent = T.replicate depth "\t"+ params = case directiveParams d of+ [] -> ""+ ps -> " " <> T.unwords (map quoteWord ps)+ block = case directiveChildren d of+ [] -> ""+ cs ->+ " {\n"+ <> foldMap (formatDirective (depth + 1)) cs+ <> indent+ <> "}"++quoteWord :: Text -> Text+quoteWord t = "\"" <> T.concatMap escape t <> "\""+ where+ escape '"' = "\\\""+ escape '\\' = "\\\\"+ escape c = T.singleton c
+ src/Data/Scfg/Parser.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Scfg.Parser (parseConfig) where++import Control.Monad (void)+import Data.Char (isControl)+import Data.Functor (($>))+import Data.List.NonEmpty (head)+import Data.Maybe (catMaybes, fromMaybe)+import Data.Scfg.Types+import Data.Text (Text)+import qualified Data.Text as T+import Data.Void (Void)+import Text.Megaparsec hiding (ParseError)+import Text.Megaparsec.Char+import Prelude hiding (head)++type Parser = Parsec Void Text++parseConfig :: Text -> Either ParseError Config+parseConfig input = case parse config "" input of+ Left bundle ->+ let firstError = head (bundleErrors bundle)+ offset = errorOffset firstError+ (_, state) = reachOffset offset (bundlePosState bundle)+ SourcePos _ l c = pstateSourcePos state+ in Left+ ParseError+ { errorLine = unPos l+ , errorColumn = unPos c+ , errorMessage = T.pack (errorBundlePretty bundle)+ }+ Right c -> Right c++config :: Parser Config+config = catMaybes <$> many line <* eof++line :: Parser (Maybe Directive)+line = hspace *> ((newline $> Nothing) <|> (comment $> Nothing) <|> (Just <$> directive))++comment :: Parser ()+comment = (char '#' *> takeWhileP Nothing isVChar *> newline) $> ()++directive :: Parser Directive+directive = do+ n <- word+ params <- many (try (hspace1 *> word))+ children <- optional (try (hspace1 *> block))+ _ <- hspace *> (void newline <|> eof)+ pure (Directive n params (fromMaybe [] children))++block :: Parser [Directive]+block = do+ _ <- char '{'+ _ <- hspace *> newline+ ds <- catMaybes <$> many (try line)+ _ <- hspace *> char '}'+ pure ds++word :: Parser Text+word = dquoteWord <|> squoteWord <|> atom++atom :: Parser Text+atom = T.concat <$> some (escPair <|> takeWhile1P (Just "character") isAtomChar)++dquoteWord :: Parser Text+dquoteWord = char '"' *> (T.concat <$> many (escPair <|> takeWhile1P (Just "character") isDqChar)) <* char '"'++squoteWord :: Parser Text+squoteWord = char '\'' *> (takeWhile1P (Just "character") isSqChar <|> pure "") <* char '\''++escPair :: Parser Text+escPair = T.singleton <$> (char '\\' *> satisfy isVChar)++isVChar :: Char -> Bool+isVChar c = c == '\t' || (not (isControl c) && c /= '\n')++isAtomChar :: Char -> Bool+isAtomChar c = not (isControl c) && c /= ' ' && c /= '\n' && c /= '{' && c /= '}' && c /= '"' && c /= '\\' && c /= '\''++isDqChar :: Char -> Bool+isDqChar c = (c == '\t' || not (isControl c)) && c /= '"' && c /= '\\' && c /= '\n'++isSqChar :: Char -> Bool+isSqChar c = (c == '\t' || not (isControl c)) && c /= '\'' && c /= '\n'
+ src/Data/Scfg/Types.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE InstanceSigs #-}++-- | Core types for the scfg configuration file format.+module Data.Scfg.Types (+ Directive (..),+ Config,+ ParseError (..),+) where++import Control.Exception (Exception (..))+import Data.Text (Text)+import qualified Data.Text as T++{- | A directive: a name, zero or more parameteres, and zero or more+child directives.+-}+data Directive = Directive+ { directiveName :: Text+ , directiveParams :: [Text]+ , directiveChildren :: [Directive]+ }+ deriving (Show, Eq)++-- | A parsed scfg configuration: a list of top-level directives.+type Config = [Directive]++-- | An error that occurred while parsing a scfg configuration.+data ParseError = ParseError+ { errorLine :: Int+ -- ^ Line number of parse error+ , errorColumn :: Int+ -- ^ Column number of parse error+ , errorMessage :: Text+ -- ^ Human-readable error message describing the parse error+ }+ deriving (Show, Eq)++instance Exception ParseError where+ displayException :: ParseError -> String+ displayException = T.unpack . errorMessage
+ test/Test.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Data.Either (isLeft)+import Data.Scfg+import System.IO (hClose, hPutStr)+import System.IO.Temp (withSystemTempFile)+import Test.Hspec++main :: IO ()+main = hspec $ do+ describe "parse" $ do+ describe "directives" $ do+ it "parses a bare directive with no params" $+ parse "foo\n" `shouldBe` Right [Directive "foo" [] []]++ it "parses a directive with params" $+ parse "foo bar baz\n" `shouldBe` Right [Directive "foo" ["bar", "baz"] []]++ it "parses multiple directives" $+ parse "foo\nbar\n" `shouldBe` Right [Directive "foo" [] [], Directive "bar" [] []]++ it "parses an empty config" $+ parse "" `shouldBe` Right []++ it "accepts missing final newline" $+ parse "foo" `shouldBe` Right [Directive "foo" [] []]++ it "ignores blank lines" $+ parse "foo\n\nbar\n" `shouldBe` Right [Directive "foo" [] [], Directive "bar" [] []]++ describe "blocks" $ do+ it "parses a directive with a block" $+ parse "foo {\nbar\n}\n" `shouldBe` Right [Directive "foo" [] [Directive "bar" [] []]]++ it "allows whitespace after opening brace" $+ parse "foo { \nbar\n}\n" `shouldBe` Right [Directive "foo" [] [Directive "bar" [] []]]++ describe "trailing whitespace" $ do+ it "allows trailing whitespace after params" $+ parse "foo bar \n" `shouldBe` Right [Directive "foo" ["bar"] []]++ it "allows trailing whitespace with no params" $+ parse "foo \n" `shouldBe` Right [Directive "foo" [] []]++ describe "comments" $ do+ it "ignores comments" $+ parse "# a comment\nfoo\n" `shouldBe` Right [Directive "foo" [] []]++ it "rejects CTL characters in comments" $+ parse "# bad\1&comment\nfoo\n" `shouldSatisfy` isLeft++ describe "ParseError" $ do+ it "includes line and column of the error" $ do+ let result = parse "foo\nbar 'unterminated\n"+ case result of+ Right _ -> expectationFailure "expected parse error"+ Left err -> do+ errorLine err `shouldBe` 2+ errorColumn err `shouldBe` 5++ describe "atoms" $ do+ it "rejects single quote in atom" $+ parse "foo bar'baz\n" `shouldSatisfy` isLeft++ it "rejects CTL characters" $+ parse "foo bar\1&baz\n" `shouldSatisfy` isLeft++ it "allows C1 control characters" $+ parse "foo bar\x80baz\n" `shouldBe` Right [Directive "foo" ["bar\x80baz"] []]++ describe "double-quoted words" $ do+ it "parses double-quoted params" $+ parse "foo \"hello world\"\n" `shouldBe` Right [Directive "foo" ["hello world"] []]++ it "rejects CTL characters" $+ parse "foo \"bar\1&baz\"\n" `shouldSatisfy` isLeft++ it "allows tab" $+ parse "foo \"bar\tbaz\"\n" `shouldBe` Right [Directive "foo" ["bar\tbaz"] []]++ it "allows C1 control characters" $+ parse "foo \"bar\x80baz\"\n" `shouldBe` Right [Directive "foo" ["bar\x80baz"] []]++ describe "single-quoted words" $ do+ it "parses single-quoted params" $+ parse "foo 'hello world'\n" `shouldBe` Right [Directive "foo" ["hello world"] []]++ it "rejects newline" $+ parse "foo 'bar\nbaz'\n" `shouldSatisfy` isLeft++ it "allows tab" $+ parse "foo 'bar\tbaz'\n" `shouldBe` Right [Directive "foo" ["bar\tbaz"] []]++ it "allows C1 control characters" $+ parse "foo 'bar\x80baz'\n" `shouldBe` Right [Directive "foo" ["bar\x80baz"] []]++ describe "escape sequences" $ do+ it "parses escape sequences in atoms" $+ parse "foo bar\\=baz\n" `shouldBe` Right [Directive "foo" ["bar=baz"] []]++ it "parses escape sequences in double-quoted words" $+ parse "foo \"bar\\\"baz\"\n" `shouldBe` Right [Directive "foo" ["bar\"baz"] []]++ it "rejects CTL character" $+ parse "foo bar\\\1&baz\n" `shouldSatisfy` isLeft++ it "allows tab" $+ parse "foo bar\\\tbaz\n" `shouldBe` Right [Directive "foo" ["bar\tbaz"] []]++ describe "parseFile" $ do+ it "parses a file" $+ withSystemTempFile "scfg" $ \path h -> do+ hPutStr h "foo bar\n"+ hClose h+ result <- parseFile path+ result `shouldBe` Right [Directive "foo" ["bar"] []]++ it "returns Left on parse error" $+ withSystemTempFile "scfg" $ \path h -> do+ hPutStr h "foo 'unterminated\n"+ hClose h+ result <- parseFile path+ result `shouldSatisfy` isLeft++ describe "format" $ do+ it "formats a bare directive" $+ format [Directive "foo" [] []] `shouldBe` "\"foo\"\n"++ it "formats a directive with params" $+ format [Directive "foo" ["bar", "baz"] []] `shouldBe` "\"foo\" \"bar\" \"baz\"\n"++ it "formats a directive with a block" $+ format [Directive "foo" [] [Directive "bar" [] []]]+ `shouldBe` "\"foo\" {\n\t\"bar\"\n}\n"++ it "formats nested blocks with correct indentation" $+ format [Directive "foo" [] [Directive "bar" [] [Directive "baz" [] []]]]+ `shouldBe` "\"foo\" {\n\t\"bar\" {\n\t\t\"baz\"\n\t}\n}\n"++ it "escapes double quotes in names and params" $+ format [Directive "fo\"o" ["ba\"r"] []] `shouldBe` "\"fo\\\"o\" \"ba\\\"r\"\n"++ describe "integration" $ do+ it "parses the spec example" $+ parse+ "train \"Shinkansen\" {\n\+ \ model \"E5\" {\n\+ \ max-speed 320km/h\n\+ \ weight 453.5t\n\+ \ }\n\+ \}\n"+ `shouldBe` Right+ [ Directive+ "train"+ ["Shinkansen"]+ [ Directive+ "model"+ ["E5"]+ [ Directive "max-speed" ["320km/h"] []+ , Directive "weight" ["453.5t"] []+ ]+ ]+ ]