diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,7 @@ dist/ *.swap +.cabal-sandbox +cabal.sandbox.config +out/ +.idea/ +*.iml diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,20 +1,29 @@ -Conf: Haskell-Style Config Parsing -=== +Conf: Parser for Haskell-based configuration files. +=========== +Installation +----------- +You can install this library from Hackage via `cabal install conf` + +Description +----------- + This package is designed to allow you to create configuration files with declarative Haskell and parse the values back into Haskell code. The benefit here is to have a configuration file in Haskell that does -not have to be recompiled - it is interpreted/parsed at runtime in a +not have to be recompiled - it is interpreted/parsed at runtime in a type-safe manner. +Example usage: + ```haskell --- Example configuration "my-config" +-- /path/to/my-config.hs foo = ["bar", "baz"] spam = Eggs ``` ```haskell --- Example application +-- Application source import Data.Conf import Data.Maybe @@ -24,14 +33,28 @@ getSpam :: Conf -> Spam getSpam = fromMaybe SomethingEntirelyDifferent . getConf "spam" -getFoo :: Conf -> Maybe [Int] +getFoo :: Conf -> Maybe Int getFoo = getConf "foo" main = do - conf <- readConf "/path/to/my-config" - let spam = getSpam conf - print spam -- Output: "Eggs" - let foo = getFoo conf - print foo -- Output: "Nothing" + conf <- readConf "my-config.hs" + print $ getSpam conf -- Output: Eggs + print $ getFoo conf -- Output: Nothing +``` + +Building +-------- +```bash +cabal sandbox init # If you haven't already +cabal install -j --dependencies-only +cabal build +``` + +Running the Tests +----------------- +```bash +cabal sandbox init # If you haven't already +cabal install -j --enable-tests --dependencies-only +cabal test ``` diff --git a/conf.cabal b/conf.cabal --- a/conf.cabal +++ b/conf.cabal @@ -1,10 +1,10 @@ name: conf -version: 0.1.0.0 +version: 0.1.1.0 license: BSD3 license-file: LICENSE author: Cary M. Robbins maintainer: carymrobbins@gmail.com -copyright: Copyright (C) 2014 Cary M. Robbins +copyright: Copyright (C) 2015 Cary M. Robbins category: Configuration, Parsing build-type: Simple cabal-version: >=1.10 @@ -13,7 +13,7 @@ This package is designed to allow you to create configuration files with declarative Haskell and parse the values back into Haskell code. The benefit here is to have a configuration file in Haskell that does - not have to be recompiled - it is interpreted/parsed at runtime in a + not have to be recompiled - it is interpreted/parsed at runtime in a type-safe manner. . Example usage: @@ -21,32 +21,31 @@ > -- /path/to/my-config.hs > foo = ["bar", "baz"] > spam = Eggs - > + . > -- Application source > import Data.Conf > import Data.Maybe - > + > > data Spam = Eggs | Parrot | SomethingEntirelyDifferent > deriving (Show, Read) - > + > > getSpam :: Conf -> Spam > getSpam = fromMaybe SomethingEntirelyDifferent . getConf "spam" - > - > getFoo :: Conf -> Maybe Foo + > + > getFoo :: Conf -> Maybe Int > getFoo = getConf "foo" > > main = do > conf <- readConf "my-config.hs" - > let spam = getSpam conf - > print spam - > let foo = getFoo conf - > print foo + > print $ getSpam conf -- Output: Eggs + > print $ getFoo conf -- Output: Nothing extra-source-files: LICENSE README.md Setup.hs .gitignore + tools/generate-readme.hs source-repository head type: git @@ -55,11 +54,21 @@ library exposed-modules: Data.Conf , Data.Conf.Parser - -- other-modules: - -- other-extensions: - build-depends: base >=4.6 && <4.7 - , haskell-src hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + build-depends: base >=4.6 && <4.8 + , haskell-src +Test-Suite unit-test + type: exitcode-stdio-1.0 + main-is: UnitTests.hs + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: conf + , base >=4.6 && <4.8 + , HUnit + , test-framework + , test-framework-hunit + , test-framework-th + other-extensions: TemplateHaskell diff --git a/src/Data/Conf.hs b/src/Data/Conf.hs --- a/src/Data/Conf.hs +++ b/src/Data/Conf.hs @@ -1,4 +1,4 @@ -module Data.Conf (Conf, readConf, getConf) where +module Data.Conf (Conf, readConf, getConf, parseConf) where import Control.Monad import Text.Read @@ -9,4 +9,3 @@ readConf :: String -> IO [(String, String)] readConf = liftM parseConf . readFile - diff --git a/src/Data/Conf/Parser.hs b/src/Data/Conf/Parser.hs --- a/src/Data/Conf/Parser.hs +++ b/src/Data/Conf/Parser.hs @@ -1,24 +1,26 @@ module Data.Conf.Parser (Conf, parseConf) where +import Data.Maybe + import Language.Haskell.Parser import Language.Haskell.Pretty import Language.Haskell.Syntax type Conf = [(String, String)] -getModule :: ParseResult HsModule -> HsModule -getModule (ParseOk x) = x +getModule :: ParseResult HsModule -> Maybe HsModule +getModule (ParseOk x) = Just x +getModule _ = Nothing -getDecl :: HsModule -> [HsDecl] -getDecl (HsModule _ _ _ _ ds) = ds +getDecls :: HsModule -> [HsDecl] +getDecls (HsModule _ _ _ _ ds) = ds -getPair :: HsDecl -> (String, HsExp) -getPair (HsPatBind _ (HsPVar (HsIdent name)) (HsUnGuardedRhs value) _) = - (name, value) +getPair :: HsDecl -> Maybe (String, HsExp) +getPair (HsPatBind _ (HsPVar (HsIdent name)) (HsUnGuardedRhs value) _) = Just (name, value) +getPair _ = Nothing parseDecls :: String -> [HsDecl] -parseDecls = getDecl . getModule . parseModule +parseDecls s = maybe [] getDecls $ getModule $ parseModule s parseConf :: String -> Conf -parseConf = map (fmap prettyPrint . getPair) . parseDecls - +parseConf s = map (fmap prettyPrint) $ mapMaybe getPair $ parseDecls s diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs new file mode 100644 --- /dev/null +++ b/tests/UnitTests.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Test.Framework +import Test.Framework.TH +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (test) + +import Data.Conf +import Data.Maybe + +myConfig = unlines + [ "foo = [\"bar\", \"baz\"]" + , "spam = Eggs" + ] + +data Spam = Eggs | Parrot | SomethingEntirelyDifferent + deriving (Show, Read, Eq) + +getSpam :: Conf -> Spam +getSpam = fromMaybe SomethingEntirelyDifferent . getConf "spam" + +getFoo :: Conf -> Maybe Int +getFoo = getConf "foo" + +case_example_usage = do + let conf = parseConf myConfig + getSpam conf @=? Eggs + getFoo conf @=? Nothing + +main = $(defaultMainGenerator) diff --git a/tools/generate-readme.hs b/tools/generate-readme.hs new file mode 100644 --- /dev/null +++ b/tools/generate-readme.hs @@ -0,0 +1,96 @@ +#!/usr/bin/env runghc + +import Control.Arrow +import Data.Function +import Data.List +import Data.Maybe +import System.Environment + +title = "Conf" +cabalFileName = "conf.cabal" +outputFileName = "README.md" + +header synopsis = unlines + [ title `applySynopsis` synopsis + , "===========" + , "" + , "Installation" + , "-----------" + , "You can install this library from Hackage via `cabal install conf`" + , "" + , "Description" + , "-----------" + ] + +footer = unlines + [ "Building" + , "--------" + , "```bash" + , "cabal sandbox init # If you haven't already" + , "cabal install -j --dependencies-only" + , "cabal build" + , "```" + , "" + , "Running the Tests" + , "-----------------" + , "```bash" + , "cabal sandbox init # If you haven't already" + , "cabal install -j --enable-tests --dependencies-only" + , "cabal test" + , "```" + ] + +main = do + args <- getArgs + cabal <- readFile cabalFileName + let synopsis = parseSynopsis cabal + let readme = unlines [header synopsis, parseBody cabal, footer] + handleArgs args readme + +handleArgs args + | "--stdout" `elem` args = putStrLn + | otherwise = writeFile outputFileName + +applySynopsis title synopsis = intercalate ": " . filter (not . null) $ xs + where + xs = [title, synopsis] + +parseSynopsis = + lines >>> + filter ("synopsis:" `isPrefixOf`) >>> + head >>> + break (== ':') >>> + snd >>> + dropWhile (`elem` [':', ' ']) + +parseBody = + lines >>> + parseDescription >>> + parseNewlines >>> + parseCode >>> + unlines + +parseDescription = + dropWhile (/= "description:") >>> + drop 1 >>> + takeWhile ((== " ") . take 1) >>> + map (dropWhile ((== ' '))) + +parseNewlines = map f + where + f "." = "" + f x = x + +parseCode :: [String] -> [String] +parseCode = + groupBy ((==) `on` take 1) >>> + map applyCodeBlocks >>> + concat + +applyCodeBlocks :: [String] -> [String] +applyCodeBlocks xs + | isCode xs = [ "```haskell" ] ++ map (drop 2) xs ++ [ "```" ] + | otherwise = xs + +isCode :: [String] -> Bool +isCode xs = (take 1 xs >>= take 1) == ">"