diff --git a/bin/ConfFmt.hs b/bin/ConfFmt.hs new file mode 100644 --- /dev/null +++ b/bin/ConfFmt.hs @@ -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 " + exitFailure diff --git a/bin/FromConf.hs b/bin/FromConf.hs new file mode 100644 --- /dev/null +++ b/bin/FromConf.hs @@ -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 " diff --git a/bin/ToConf.hs b/bin/ToConf.hs new file mode 100644 --- /dev/null +++ b/bin/ToConf.hs @@ -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 " diff --git a/default.conf.json.conf b/default.conf.json.conf new file mode 100644 --- /dev/null +++ b/default.conf.json.conf @@ -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; + } +} diff --git a/language-conf.cabal b/language-conf.cabal --- a/language-conf.cabal +++ b/language-conf.cabal @@ -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 diff --git a/src/ConfFmt.hs b/src/ConfFmt.hs deleted file mode 100644 --- a/src/ConfFmt.hs +++ /dev/null @@ -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 " - exitFailure diff --git a/src/Data/Conf/Aeson.hs b/src/Data/Conf/Aeson.hs --- a/src/Data/Conf/Aeson.hs +++ b/src/Data/Conf/Aeson.hs @@ -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 _) = [] diff --git a/src/Data/Conf/Types.hs b/src/Data/Conf/Types.hs --- a/src/Data/Conf/Types.hs +++ b/src/Data/Conf/Types.hs @@ -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 _) = [] - diff --git a/test/Data/Conf/AesonSpec.hs b/test/Data/Conf/AesonSpec.hs --- a/test/Data/Conf/AesonSpec.hs +++ b/test/Data/Conf/AesonSpec.hs @@ -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" ] ]