language-conf 0.2.0.0 → 0.2.1.0
raw patch · 9 files changed
+243/−90 lines, 9 filesdep +bytestringdep +yamldep ~aesondep ~basedep ~filepathnew-component:exe:fromconfnew-component:exe:toconf
Dependencies added: bytestring, yaml
Dependency ranges changed: aeson, base, filepath, megaparsec, text
Files
- bin/ConfFmt.hs +20/−0
- bin/FromConf.hs +25/−0
- bin/ToConf.hs +27/−0
- default.conf.json.conf +22/−0
- language-conf.cabal +55/−7
- src/ConfFmt.hs +0/−20
- src/Data/Conf/Aeson.hs +47/−0
- src/Data/Conf/Types.hs +1/−46
- test/Data/Conf/AesonSpec.hs +46/−17
+ bin/ConfFmt.hs view
@@ -0,0 +1,20 @@+import qualified Data.Conf as Conf+import qualified Data.Conf.PrettyPrint as Conf+import qualified Data.Text.IO as Text (readFile)+import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO+import qualified Text.Megaparsec as Megaparsec++main :: IO ()+main = do+ as <- getArgs+ case as of+ (filePath:_) -> do+ contents <- Text.readFile filePath+ case Megaparsec.parse Conf.conf filePath contents of+ Left err -> hPrint stderr err+ Right ast -> print (Conf.pPrint ast)+ _ -> do+ hPutStrLn stderr "Usage: conffmt <conf-file>"+ exitFailure
+ bin/FromConf.hs view
@@ -0,0 +1,25 @@+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Conf as Conf+import Data.Monoid+import qualified Data.Text.IO as Text+import qualified Data.Yaml as Yaml+import System.Environment+import System.FilePath+import qualified Text.Megaparsec as Megaparsec++main :: IO ()+main = do+ as <- getArgs+ case as of+ (fp:output:_) -> do+ fcontents <- Text.readFile fp+ let conf = case Megaparsec.parse Conf.conf fp fcontents of+ Right c -> c+ Left e -> error ("Failed to parse " <> fp <> "\n" <> show e)+ confv = Aeson.toJSON conf+ case takeExtension output of+ ".json" -> ByteString.writeFile output (Aeson.encode confv)+ ".yaml" -> Yaml.encodeFile output confv+ _ -> error "Unsupported output format"+ _ -> error "Usage: fromconf <inputfile> <outputfile>"
+ bin/ToConf.hs view
@@ -0,0 +1,27 @@+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Conf as Conf+import Data.Monoid+import qualified Data.Text.IO as Text+import qualified Data.Yaml as Yaml+import System.Environment+import System.FilePath+import qualified Text.Megaparsec as Megaparsec++main :: IO ()+main = do+ as <- getArgs+ case as of+ (fp:output:_) -> do+ mv <- case takeExtension fp of+ ".yaml" -> Yaml.decodeFile fp+ ".json" -> Aeson.decode <$> ByteString.readFile fp+ case mv of+ Just v -> do+ let conf :: Aeson.Result Conf.Conf+ conf = Aeson.fromJSON v+ writeFile output $ show $ case conf of+ Aeson.Success c -> Conf.pPrint c+ Aeson.Error e -> error ("Tranformation failure: " <> e)+ Nothing -> error ("Parse failure " <> fp)+ _ -> error "Usage: toconf <inputfile> <outputfile>"
+ default.conf.json.conf view
@@ -0,0 +1,22 @@+worker_processes 1;+events {+ worker_connections 1024;+}+http {+ include servers/*;+ keepalive_timeout 65;+ default_type application/octet-stream;+ sendfile on;+ server {+ server_name localhost;+ location = /50x.html {+ root html;+ }+ error_page 500 502 503 504 /50x.html;+ location / {+ root /usr/local/Library/Taps/railwaycat/homebrew-emacsmacport;+ index index.html index.htm;+ }+ listen 9898;+ }+}
language-conf.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: language-conf-version: 0.2.0.0+version: 0.2.1.0 synopsis: Conf parsers and pretty-printers for the Haskell programming language. description: @language-conf@ contains @.conf@ (e.g. nginx configuration) parsers and pretty-printers for the Haskell programming language. "Data.Conf" exports all the API surface in the package.@@ -21,6 +21,7 @@ extra-source-files: ./default.conf+ ./default.conf.json.conf ./small.conf source-repository head@@ -32,6 +33,16 @@ manual: False default: False +flag fromconf+ description: Build the fromconf utility+ manual: False+ default: False++flag toconf+ description: Build the toconf utility+ manual: False+ default: False+ library hs-source-dirs: src@@ -59,7 +70,7 @@ executable conffmt main-is: ConfFmt.hs hs-source-dirs:- src+ bin build-depends: base , text@@ -69,11 +80,48 @@ if !(flag(conffmt)) buildable: False other-modules:- Data.Conf- Data.Conf.Aeson- Data.Conf.Internal- Data.Conf.PrettyPrint- Data.Conf.Types+ FromConf+ ToConf+ default-language: Haskell2010++executable fromconf+ main-is: FromConf.hs+ hs-source-dirs:+ bin+ build-depends:+ base+ , language-conf+ , text+ , bytestring+ , megaparsec+ , filepath+ , aeson+ , yaml+ if !(flag(fromconf))+ buildable: False+ other-modules:+ ConfFmt+ ToConf+ default-language: Haskell2010++executable toconf+ main-is: ToConf.hs+ hs-source-dirs:+ bin+ build-depends:+ base+ , language-conf+ , text+ , bytestring+ , megaparsec+ , filepath+ , aeson+ , yaml+ if !(flag(toconf))+ buildable: False+ other-modules:+ ConfFmt+ FromConf default-language: Haskell2010 test-suite hspec
− src/ConfFmt.hs
@@ -1,20 +0,0 @@-import qualified Data.Conf as Conf-import qualified Data.Conf.PrettyPrint as Conf-import qualified Data.Text.IO as Text (readFile)-import System.Environment (getArgs)-import System.Exit (exitFailure)-import System.IO-import qualified Text.Megaparsec as Megaparsec--main :: IO ()-main = do- as <- getArgs- case as of- (filePath:_) -> do- contents <- Text.readFile filePath- case Megaparsec.parse Conf.conf filePath contents of- Left err -> hPrint stderr err- Right ast -> print (Conf.pPrint ast)- _ -> do- hPutStrLn stderr "Usage: conffmt <conf-file>"- exitFailure
src/Data/Conf/Aeson.hs view
@@ -1,8 +1,55 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-} module Data.Conf.Aeson where +import Control.Monad import Data.Aeson+import Data.Aeson+import Data.Aeson.Types+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Scientific as Scientific+import Data.String+import qualified Data.Text as Text+import qualified Data.Vector as Vector++import Data.Conf.PrettyPrint import Data.Conf.Types fromToJSON :: ToJSON a => a -> Result Conf fromToJSON = fromJSON . toJSON++instance FromJSON Conf where+ parseJSON (Object obj) = do+ let oList = HashMap.toList obj+ forM oList $ \(k, v) ->+ case v of+ o@(Object _) -> do+ cs <- parseJSON o+ return $ ConfStatementBlock (Block (Text.words k) cs)+ (Array vs) -> return $+ ConfStatementExpression (Expression k (map toExpressionValue (Vector.toList vs)))+ value -> return $+ ConfStatementExpression (Expression k [toExpressionValue value])+ where+ toExpressionValue (Number oc) =+ case Scientific.floatingOrInteger oc of+ Left f -> fromString (show (f :: Double))+ Right i -> fromString (show (i :: Integer))+ toExpressionValue (String oc) = oc+ toExpressionValue (Bool b) = if b then "true" else "false"+ toExpressionValue _ = error "Invalid type"++ parseJSON invalid = typeMismatch "Conf" invalid++instance ToJSON Conf where+ toJSON cs = object ps+ where+ ps = concatMap toPair cs+ toPair (ConfStatementExpression (Expression e [v])) = [ e .= String v ]+ toPair (ConfStatementExpression (Expression e vs)) = [ e .= toJSON vs ]+ toPair (ConfStatementBlock (Block [k] css)) = [ k .= toJSON css ]+ toPair (ConfStatementBlock (Block ks css)) = [ Text.unwords ks .= toJSON css ]+ toPair ConfStatementEmptyLine = []+ toPair (ConfStatementComment _) = []
src/Data/Conf/Types.hs view
@@ -1,18 +1,7 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-} module Data.Conf.Types where -import Control.Monad-import Data.Aeson-import Data.Aeson.Types-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Scientific as Scientific-import Data.String-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Vector as Vector+import Data.Text (Text) type Conf = [ConfStatement] @@ -32,37 +21,3 @@ data Expression = Expression Text [Text] deriving(Eq, Show)--instance FromJSON Conf where- parseJSON (Object o) = do- let oList = HashMap.toList o- forM oList $ \(k, v) ->- case v of- o@(Object _) -> do- cs <- parseJSON o- return $ ConfStatementBlock (Block [k] cs)- (Array vs) -> return $- ConfStatementExpression (Expression k (map toExpressionValue (Vector.toList vs)))- value -> return $- ConfStatementExpression (Expression k [toExpressionValue value])- where- toExpressionValue (Number oc) =- case Scientific.floatingOrInteger oc of- Left f -> fromString (show (f :: Double))- Right i -> fromString (show (i :: Integer))- toExpressionValue (String oc) = oc- toExpressionValue (Bool b) = if b then "true" else "false"-- parseJSON invalid = typeMismatch "Conf" invalid--instance ToJSON Conf where- toJSON cs = object ps- where- ps = concatMap toPair cs- toPair (ConfStatementExpression (Expression e [v])) = [ e .= String v ]- toPair (ConfStatementExpression (Expression e vs)) = [ e .= toJSON vs ]- toPair (ConfStatementBlock (Block [k] css)) = [ k .= toJSON css ]- toPair (ConfStatementBlock (Block ks css)) = [ Text.pack (show ks) .= toJSON css ]- toPair ConfStatementEmptyLine = []- toPair (ConfStatementComment _) = []-
test/Data/Conf/AesonSpec.hs view
@@ -9,24 +9,53 @@ spec :: Spec spec = do- describe "fromValue" $+ describe "fromValue" $ do it "should convert objects to ConfStatements" $ do- let inp = object [ "hello" .= String "world"- , "object" .= object [ "here" .= Number 8888- ]- ]- fromJSON inp `shouldBe` Success [ ConfStatementExpression (Expression "hello" ["world"])- , ConfStatementBlock (Block ["object"] [ ConfStatementExpression (Expression "here" ["8888"])- ])- ]+ let inp = object [ "hello" .= String "world"+ , "object" .= object [ "here" .= Number 8888 ]+ ]+ fromJSON inp `shouldBe`+ Success [ ConfStatementExpression (Expression "hello"+ [ "world" ])+ , ConfStatementBlock (Block [ "object" ]+ [ ConfStatementExpression (Expression "here"+ [ "8888"+ ])+ ])+ ] - describe "toValue" $+ it "should convert from list keys words" $ do+ let inp = object [ "location /" .=+ object [ "here" .= String "8888" ]+ ]+ fromJSON inp `shouldBe`+ Success [ ConfStatementBlock (Block [ "location", "/" ]+ [ ConfStatementExpression (Expression "here"+ [ "8888"+ ])+ ])+ ]++ describe "toValue" $ do it "should convert objects to ConfStatements" $ do- let inp = [ ConfStatementExpression (Expression "hello" ["world"])- , ConfStatementBlock (Block ["object"] [ ConfStatementExpression (Expression "here" ["8888"])- ])+ let inp = [ ConfStatementExpression (Expression "hello" [ "world" ])+ , ConfStatementBlock (Block [ "object" ]+ [ ConfStatementExpression (Expression "here"+ [ "8888"+ ])+ ])+ ]+ toJSON inp `shouldBe`+ object [ "hello" .= String "world"+ , "object" .= object [ "here" .= String "8888" ] ]- toJSON inp `shouldBe` object [ "hello" .= String "world"- , "object" .= object [ "here" .= String "8888"- ]- ]++ it "should convert list keys onto words" $ do+ let inp = [ ConfStatementBlock (Block [ "location", "/" ]+ [ ConfStatementExpression (Expression "here"+ [ "8888"+ ])+ ])+ ]+ toJSON inp `shouldBe`+ object [ "location /" .= object [ "here" .= String "8888" ] ]