packages feed

simple-config (empty) → 1.0.0

raw patch · 8 files changed

+347/−0 lines, 8 filesdep +basedep +bytestringdep +data-defaultsetup-changed

Dependencies added: base, bytestring, data-default, network, parsec3, template-haskell, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Yusuke Nomura++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yusuke Nomura nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Config.hs view
@@ -0,0 +1,36 @@+-- | Simple-config is a parser generator for simple configuration file.+--+-- To use this library, one needs import a module and set extensions.+--+-- > {-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+-- > import Text.Config+--+-- The following is quick example.+--+-- > mkConfig "configParser" [config|+-- > TestConfig+-- >     uri  URI+-- >     text String+-- >     list [String]+-- > |]+--+-- The example generates following codes.+--+-- > data TestConfig = TestConfig+-- >     { uri  :: String+-- >     , text :: String+-- >     , list :: [String]+-- >     }+-- > +-- > configParser :: Parser TestConfig+-- > configParser = ...+--+module Text.Config+    ( -- * Types+      module Text.Config.Types+    , module Text.Config.TH+    ) where++import Text.Config.Types+import Text.Config.TH+
+ Text/Config/Lib.hs view
@@ -0,0 +1,45 @@+module Text.Config.Lib+    where++import Text.Parsec+import Text.Parsec.ByteString+import Control.Applicative hiding (many, (<|>))+import Network.URI++comment :: Parser ()+comment = () <$ string "--" <* many (noneOf "\n")++commentLine :: Parser ()+commentLine = () <$ (comment *> newline <|> newline)++commentLines :: Parser ()+commentLines = () <$ many commentLine++key :: Parser String+key = many1 $ oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"++spcs :: Parser ()+spcs = () <$ many spc++spcs1 :: Parser ()+spcs1 = () <$ many1 spc++spc :: Parser Char+spc = satisfy (`elem` " \t")++cv_string :: Parser String+cv_string = many1 (noneOf ", \t\r\n") <* spcs++cv_list :: Parser p -> Parser [p]+cv_list p = sepBy p (spcs *> char ',' <* spcs) <* spcs++cv_uri :: Parser String+cv_uri = do+    str <- cv_string+    if isURI str+      then return str+      else fail "parse error: URI"++sep :: Parser ()+sep = () <$ char ':' *> spcs+
+ Text/Config/Parser.hs view
@@ -0,0 +1,44 @@+module Text.Config.Parser+    ( loadConfigTmp+    , confTmpParser+    ) where++import Text.Parsec+import Text.Parsec.ByteString+import Control.Applicative hiding (many, (<|>))+import qualified Data.ByteString.Char8 as BC++import Text.Config.Lib+import Text.Config.Types++loadConfigTmp :: String -> IO ConfTmp+loadConfigTmp filepath = do+    str <- readFile filepath+    return $ confTmpParser str++confTmpParser :: String -> ConfTmp+confTmpParser str =+    case parse confTmp "" (BC.pack str) of+        Left err   -> error $ show err+        Right conf -> conf++confTmp :: Parser ConfTmp+confTmp = (,)+    <$> (commentLines *> key <* spcs <* commentLines)+    <*> confLines++confLines :: Parser [ConfLine]+confLines = commentLines *> many1 confLine <* eof++confLine :: Parser ConfLine+confLine = (,)+    <$> (spcs1 *> key <* spcs1)+    <*> (confType <* spcs <* commentLines)++confType :: Parser ConfType+confType = choice [typeString, typeUri, typeList]+  where+    typeString = string "String" *> return ConfString+    typeUri = string "URI" *> return ConfURI+    typeList = ConfList <$> (char '[' *> confType) <* char ']'+
+ Text/Config/TH.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ConstraintKinds #-}+module Text.Config.TH+    ( -- * Generate+      mkConfig+      -- * Quote+    , config+    ) where++import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Control.Applicative+import Text.Parsec hiding ((<|>), many)+import Text.Parsec.ByteString (Parser)+import Data.Default+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State++import Text.Config.Parser+import Text.Config.Types+import Text.Config.Lib++config :: QuasiQuoter+config = QuasiQuoter+    { quoteExp = \str -> [|confTmpParser str|]+    , quotePat = undefined+    , quoteType = undefined+    , quoteDec = undefined+    }++mkConfig :: String -> ConfTmp -> DecsQ+mkConfig name (nameStr, confLines) = f+    <$> mkRecord recName confLines+    <*> instanceDef recName confLines+    <*> mkParsers recName confLines+    <*> mkParser name recName confLines+  where+    recName = mkName nameStr+    f a b c d = a:b:(c++d)++{-+レコードを作る。+-}+mkRecord :: Name -> [ConfLine] -> DecQ+mkRecord recName confLines =+    dataD (cxt []) recName [] [rec] [''Show]+  where+    rec = recC recName $ map confVSType confLines++    confVSType :: ConfLine -> VarStrictTypeQ+    confVSType (name, ctype) = confVSType' name $ confTypeQ ctype++    confVSType' :: String -> TypeQ -> VarStrictTypeQ+    confVSType' name typeq =+        varStrictType (mkName name) $ strictType notStrict typeq++    confTypeQ :: ConfType -> TypeQ+    confTypeQ ConfString = [t|String|]+    confTypeQ ConfURI = [t|String|]+    confTypeQ (ConfList ctype) = [t|[$(confTypeQ ctype)]|]++{-+Data.Defaultのインスタンスにする+-}+instanceDef :: Name -> [ConfLine] -> DecQ+instanceDef recName confLines =+    instanceD (return []) types [func]+  where+    types = [t|Default $(conT recName)|]+    cons = recConE recName $ map defVal confLines+    func = valD (varP 'def) (normalB cons) []++    defVal :: ConfLine -> Q (Name, Exp)+    defVal (n, ConfString) = (,) (mkName n) <$> [|""|]+    defVal (n, ConfURI)    = (,) (mkName n) <$> [|"http://localhost/"|]+    defVal (n, ConfList _) = (,) (mkName n) <$> [|[]|]++mkParsers :: Name -> [ConfLine] -> DecsQ+mkParsers recName confLines =+    concat <$> mapM (mkVal recName) confLines++{-+val_field :: StateT Config Parser ()+val_field = do+    a <- lift $ val cv_string "field"+    c <- get+    put c{field=a}+-}+mkVal :: Name -> ConfLine -> DecsQ+mkVal recName (name, ctype) = do+    s <- sigD funcName sigt+    a <- newName "a"+    c <- newName "c"+    f <- funD funcName [clause [] (body a c) []]+    return [s, f]+  where+    fieldName = mkName name+    funcName = parserName name+    sigt = [t|StateT $(conT recName) Parser ()|]+    body a c = normalB $ doE [+        bindS (varP a) [|lift $ try $ val $(confParser ctype) name|],+        bindS (varP c) [|get|],+        noBindS [|put $(recUpdE (varE c) [(,) fieldName <$> (varE a)])|]]++{-+こういうのを作る+configParser :: Parser Config+configParser = execStateT (lift commentLines *> (many (parsers <* lift commentLines)) <* lift eof) def+-}+mkParser :: String -> Name -> [ConfLine] -> DecsQ+mkParser name recName cl = do+    s <- sigD funcName [t|Parser $(conT recName)|]+    v <- valD (varP funcName) (normalB body) []+    return [s, v]+  where+    funcName = mkName name+    body = [|execStateT (lift commentLines *> (many ($(getFieldParser cl) <* lift commentLines)) <* lift eof) def|]++{-+ - こういう式+fold1 (<|>) [val_string, val_uri, val_int]+ -}+getFieldParser :: [ConfLine] -> ExpQ+getFieldParser confLines = [|foldl1 (<|>) $(listE funcs)|]+  where+    funcs = map (varE . parserName . fst) confLines++parserName :: String -> Name+parserName name = mkName $ "val_" ++ name++{-+    val cv_string+の部分をConfTypeごとに作る+-}+confParser :: ConfType -> ExpQ+confParser ConfString = [|cv_string|]+confParser ConfURI = [|cv_uri|]+confParser (ConfList ctype) = [|cv_list $(confParser ctype)|]++val :: Parser a -> String -> Parser a+val p name = (string name *> spcs *> sep *> p) <* spcs <* commentLine+
+ Text/Config/Types.hs view
@@ -0,0 +1,13 @@+module Text.Config.Types+    where++data ConfType+    = ConfString+    | ConfURI+    | ConfList ConfType+  deriving (Show)++type ConfLine = (String, ConfType)++type ConfTmp = (String, [ConfLine])+
+ simple-config.cabal view
@@ -0,0 +1,35 @@+Name:                simple-config+Version:             1.0.0+Synopsis:            Simple config file parser generator+Description:         Simple config file parser generator+Homepage:            https://github.com/yunomu/simple-config+License:             BSD3+License-file:        LICENSE+Author:              YusukeNomura+Maintainer:          yunomu@gmail.com+-- Copyright:           +Category:            Text+Build-type:          Simple++Cabal-version:       >=1.6++Library+  Exposed-modules:   Text.Config+  Ghc-options:       -Wall+  Build-depends:     base >= 4 && < 5+                   , network+                   , parsec3+                   , bytestring+                   , transformers+                   , data-default+                   , template-haskell++  Other-modules:     Text.Config.TH+                   , Text.Config.Lib+                   , Text.Config.Parser+                   , Text.Config.Types++Source-repository head+    Type:            git+    Location:        git://github.com/yunomu/simple-config.git+