diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Pedro Tacla Yamada + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/language-conf.cabal b/language-conf.cabal new file mode 100644 --- /dev/null +++ b/language-conf.cabal @@ -0,0 +1,92 @@ +-- This file has been generated from package.yaml by hpack version 0.14.0. +-- +-- see: https://github.com/sol/hpack + +name: language-conf +version: 0.1.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. + "ConfFmt" is a @.conf@ file formatter that serves as an example; it's built as @conffmt@ by the cabal configuration. You can see its' source-code +category: Data +homepage: https://github.com/beijaflor-io/haskell-language-conf#readme +bug-reports: https://github.com/beijaflor-io/haskell-language-conf/issues +author: Pedro Tacla Yamada +maintainer: tacla.yamada@gmail.com +copyright: Copyright (c) 2016 Pedro Tacla Yamada +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +source-repository head + type: git + location: https://github.com/beijaflor-io/haskell-language-conf + +flag conffmt + description: Build the conffmt utility + manual: False + default: False + +library + hs-source-dirs: + src + build-depends: + base >=4.8 && <5 + , deepseq + , directory >=1.2.2.0 + , filepath >=1.4.0.0 + , megaparsec >=5 + , pretty + , scientific >=0.3.4.6 + , semigroups >=0.18.1 + , text >=1.2.2.1 + , unordered-containers + exposed-modules: + Data.Conf + Data.Conf.PrettyPrint + Data.Conf.Types + Data.Conf.Internal + default-language: Haskell2010 + +executable conffmt + main-is: ConfFmt.hs + hs-source-dirs: + src + build-depends: + base + , text + , megaparsec + , language-conf + , pretty + if !(flag(conffmt)) + buildable: False + other-modules: + Data.Conf + Data.Conf.Internal + Data.Conf.PrettyPrint + Data.Conf.Types + default-language: Haskell2010 + +test-suite hspec + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + build-depends: + QuickCheck + , base + , directory + , filepath + , hspec + , language-conf + , megaparsec + , hspec-megaparsec + , pretty + , semigroups >=0.18.1 + , text + , transformers >=0.4.2.0 + other-modules: + Data.ConfSpec + SanitySpec + default-language: Haskell2010 diff --git a/src/ConfFmt.hs b/src/ConfFmt.hs new file mode 100644 --- /dev/null +++ b/src/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/src/Data/Conf.hs b/src/Data/Conf.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conf.hs @@ -0,0 +1,40 @@ +{-| +Module: Data.Conf +Description: Exports a @.conf@ Megaparsec parser through 'conf' +Copyright: (c) Copyright Pedro Tacla Yamada 2016 +License: MIT +Maintainer: tacla.yamada@gmail.com +Stability: experimental +Portability: unknown + +This modules contains the 'conf' Megaparsec parser for @.conf@ files and Pretty +instance. +-} +module Data.Conf + ( + -- * Entry-points + conf + , pPrintConf + , runParser + -- * Types + , Conf (..) + , ConfStatement (..) + , Block (..) + , Comment (..) + , Expression (..) + -- * Parser + , confStatement + , confStatementLines + , block + , expression + , argument + -- * Pretty-printer + , Pretty(..) + , pPrint + ) + where + +import Data.Conf.Internal +import Data.Conf.PrettyPrint +import Data.Conf.Types +import Text.Megaparsec (runParser) diff --git a/src/Data/Conf/Internal.hs b/src/Data/Conf/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conf/Internal.hs @@ -0,0 +1,77 @@ +module Data.Conf.Internal + where + +import Control.Monad (void) +import Data.Conf.Types +import Data.Either +import Data.Maybe (catMaybes, fromMaybe) +import Data.Text (Text) +import qualified Data.Text as Text +import Text.Megaparsec +import Text.Megaparsec.Text + +-- | The .conf parser +-- +-- See "Text.Megaparsec" +conf :: Parser Conf +conf = label "conf" $ + postProcessStatementLines <$> manyTill confStatementLines eof + +-- ** Support functions +skipSpace :: Parser () +skipSpace = void $ many spaceChar + +confStatement :: Parser ConfStatement +confStatement = label "confStatement" $ + try (ConfStatementComment <$> comment) + <|> try (ConfStatementBlock <$> block) + <|> ConfStatementExpression <$> expression + +confStatementLines :: Parser [ConfStatement] +confStatementLines = do + skipSpace + s <- confStatement + -- If we're after a comment, the parser consumed a EOL. Anywhere else we + -- should look for two ends of lines repeated (the end of the current + -- expression, plus an empty one) + me <- optional $ try $ case s of + ConfStatementComment _ -> eol >> return ConfStatementEmptyLine + _ -> eol >> eol >> return ConfStatementEmptyLine + skipSpace + return $ catMaybes [Just s, me] + +postProcessStatementLines :: [[ConfStatement]] -> [ConfStatement] +postProcessStatementLines = removeTrailing . concat + where + removeTrailing [] = [] + removeTrailing xs | last xs == ConfStatementEmptyLine = init xs + | otherwise = xs + +comment :: Parser Comment +comment = label "comment" $ do + _ <- string "#" + -- Comments always start with a space + c <- fromMaybe ' ' <$> optional (char ' ') + Comment . Text.pack . (c:) <$> manyTill anyChar eol + +block :: Parser Block +block = label "block" $ do + s <- flip someTill (char '{') $ do + k <- Text.pack <$> + some (noneOf ['{', ' ', '}', ';']) + skipSpace + return k + skipSpace + Block s . postProcessStatementLines <$> + manyTill confStatementLines (char '}') + +expression :: Parser Expression +expression = label "expression" $ do + s <- manyTill (letterChar <|> char '_' <|> char '-') spaceChar + skipSpace + as <- manyTill argument (char ';') + return $ Expression (Text.pack s) as + +argument :: Parser Text +argument = label "argument" $ + Text.pack <$> some (noneOf [';']) diff --git a/src/Data/Conf/PrettyPrint.hs b/src/Data/Conf/PrettyPrint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conf/PrettyPrint.hs @@ -0,0 +1,55 @@ +{-| +Module: Data.Conf.PrettyPrint +Description: Pretty-printer for 'Data.Conf' +Copyright: (c) Copyright Pedro Tacla Yamada 2016 +License: MIT +Maintainer: tacla.yamada@gmail.com +Stability: experimental +Portability: unknown + +Pretty-printer for "Data.Conf". Declares a 'Pretty' instance for +'ConfStatement'. +-} +{-# LANGUAGE OverloadedStrings #-} +module Data.Conf.PrettyPrint + ( + pPrintConf + , Pretty (..) + , Doc (..) + ) + where + +import Data.Conf.Types +import Data.Text (Text) +import qualified Data.Text as Text +import Text.PrettyPrint.HughesPJClass + +-- | Pretty-prints a 'Conf' to a 'Doc' +-- +-- 'pPrint' restricted to 'Conf' +-- +-- @ +-- print (pPrintConf c) +-- @ +-- +-- See "Text.PrettyPrint" +pPrintConf = pPrint :: Conf -> Doc + +instance Pretty ConfStatement where + pPrint s = case s of + ConfStatementEmptyLine -> text "" + ConfStatementComment (Comment c) -> + "#" <> ttext c + ConfStatementBlock (Block ks ss) -> + thsep ks <+> "{" + $+$ nest 2 (pPrintList (PrettyLevel 0) ss) $+$ + "}" + ConfStatementExpression (Expression t ts) -> + ttext t <+> thsep ts <> ";" + pPrintList _ ss = foldl ($+$) empty (map pPrint ss) + +thsep :: [Text] -> Doc +thsep = hsep . map ttext + +ttext :: Text -> Doc +ttext = text . Text.unpack diff --git a/src/Data/Conf/Types.hs b/src/Data/Conf/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conf/Types.hs @@ -0,0 +1,23 @@ +module Data.Conf.Types + where + +import Data.Text (Text) + +type Conf = [ConfStatement] + +data ConfStatement = ConfStatementComment Comment + | ConfStatementBlock Block + | ConfStatementEmptyLine + -- ^ We store empty lines while parsing so we can + -- reconstruct the document when pretty-printing + | ConfStatementExpression Expression + deriving(Eq, Show) + +data Block = Block [Text] [ConfStatement] + deriving(Eq, Show) + +data Comment = Comment Text + deriving(Eq, Show) + +data Expression = Expression Text [Text] + deriving(Eq, Show) diff --git a/test/Data/ConfSpec.hs b/test/Data/ConfSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/ConfSpec.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE OverloadedStrings #-} +module Data.ConfSpec where + +import Data.Conf +import Data.Conf.Internal +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import Test.Hspec +import Test.Hspec.Megaparsec +import Text.Megaparsec + +spec :: Spec +spec = do + describe "comment" $ + it "parses a comment" $ do + let inp = Text.unlines [ "# something here" + , "" + , "# there" + ] + parse comment "" inp `shouldParse` Comment " something here" + + describe "expression" $ do + it "parses an expression" $ do + let inp = Text.unlines [ "worker_processes 1;"] + parse expression "" inp `shouldParse` Expression "worker_processes" ["1"] + + it "parses a single-line expression" $ do + let inp = "worker_processes 1;" + parse expression "" inp `shouldParse` Expression "worker_processes" ["1"] + + describe "block" $ do + it "parses a block" $ do + let inp = Text.unlines [ "http {" + , " listen 8989;" + , " proxy_pass something;" + , "}" + ] + parse block "" inp `shouldParse` Block ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + + it "parses a nested block" $ do + let inp = Text.unlines [ "http {" + , " location / {" + , " proxy_pass something;" + , " }" + , "}" + ] + parse block "" inp `shouldParse` Block ["http"] + [ ConfStatementBlock (Block + ["location", "/"] + [ConfStatementExpression (Expression "proxy_pass" ["something"])]) + ] + + it "parses empty lines" $ do + let inp = Text.unlines [ "http {" + , " listen 8989;" + , "" + , " proxy_pass something;" + , "}" + ] + parse block "" inp `shouldParse` Block ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + + it "parses skips more than one empty line" $ do + let inp = Text.unlines [ "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + ] + parse block "" inp `shouldParse` Block ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + + it "ignores one trailing line" $ do + let inp = Text.unlines [ "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + , "" + ] + parse block "" inp `shouldParse` Block ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + + it "ignores multiple trailing lines" $ do + let inp = Text.unlines [ "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + , "" + , "" + , "" + ] + parse block "" inp `shouldParse` Block ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + + describe "conf" $ do + it "parses nginx configuration successfully" $ do + inp <- Text.readFile "default.conf" + parse conf "" `shouldSucceedOn` inp + + it "ignores one leading line" $ do + let inp = Text.unlines [ "" + , "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + , "" + , "" + , "" + ] + parse conf "" inp `shouldParse` [ ConfStatementBlock $ Block + ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + ] + + it "ignores multiple leading lines" $ do + let inp = Text.unlines [ "" + , "" + , "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + , "" + , "" + , "" + ] + parse conf "" inp `shouldParse` [ ConfStatementBlock $ Block + ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + ] + + it "ignores multiple trailing lines" $ do + let inp = Text.unlines [ "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + , "" + , "" + , "" + ] + parse conf "" inp `shouldParse` [ ConfStatementBlock $ Block + ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + ] + + it "parses comments" $ do + let inp = Text.unlines [ " # something" + , "" + , "http {" + , " listen 8989;" + , "" + , "" + , " proxy_pass something;" + , "}" + , "" + , "" + , "" + ] + parse conf "" inp `shouldParse` [ ConfStatementComment $ Comment " something" + , ConfStatementEmptyLine + , ConfStatementBlock $ Block + ["http"] + [ ConfStatementExpression (Expression "listen" ["8989"]) + , ConfStatementEmptyLine + , ConfStatementExpression (Expression "proxy_pass" ["something"]) + ] + ] diff --git a/test/SanitySpec.hs b/test/SanitySpec.hs new file mode 100644 --- /dev/null +++ b/test/SanitySpec.hs @@ -0,0 +1,6 @@ +module SanitySpec where + +import Test.Hspec + +spec = describe "when I have tests" $ + it "I have sanity" $ True `shouldBe` True diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}