ini-0.3.6/src/0000755000000000000000000000000013264117123011254 5ustar0000000000000000ini-0.3.6/src/Data/0000755000000000000000000000000013264117123012125 5ustar0000000000000000ini-0.3.6/src/Data/Ini.hs0000644000000000000000000001367313264117123013212 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -- | Clean configuration files in the INI format. -- -- Format rules and recommendations: -- -- * The @: @ syntax is space-sensitive. -- -- * Keys are case-sensitive. -- -- * Lower-case is recommended. -- -- * Values can be empty. -- -- * Keys cannot key separators, section delimiters, or comment markers. -- -- * Comments must start at the beginning of the line and start with @;@ or @#@. -- -- An example configuration file: -- -- @ -- # Some comment. -- [SERVER] -- port=6667 -- hostname=localhost -- ; another comment here -- [AUTH] -- user: hello -- pass: world -- salt: -- @ -- -- Parsing example: -- -- >>> parseIni "[SERVER]\nport: 6667\nhostname: localhost" -- Right (Ini {unIni = fromList [("SERVER",fromList [("hostname","localhost"),("port","6667")])]}) -- module Data.Ini (-- * Reading readIniFile ,parseIni ,lookupValue ,readValue ,parseValue ,sections ,keys -- * Writing ,printIni ,writeIniFile -- * Advanced writing ,KeySeparator(..) ,WriteIniSettings(..) ,defaultWriteIniSettings ,printIniWith ,writeIniFileWith -- * Types ,Ini(..) -- * Parsers ,iniParser ,sectionParser ,keyValueParser ) where import Control.Applicative import Control.Monad import Data.Attoparsec.Combinator import Data.Attoparsec.Text import Data.Char import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M import Data.Semigroup import Data.Monoid (Monoid) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Prelude hiding (takeWhile) -- | An INI configuration. newtype Ini = Ini { unIni :: HashMap Text (HashMap Text Text) } deriving (Show, Semigroup, Monoid) -- | Parse an INI file. readIniFile :: FilePath -> IO (Either String Ini) readIniFile = fmap parseIni . T.readFile -- | Parse an INI config. parseIni :: Text -> Either String Ini parseIni = parseOnly iniParser -- | Lookup values in the config. lookupValue :: Text -> Text -> Ini -> Either String Text lookupValue name key (Ini ini) = case M.lookup name ini of Nothing -> Left ("Couldn't find section: " ++ T.unpack name) Just section -> case M.lookup key section of Nothing -> Left ("Couldn't find key: " ++ T.unpack key) Just value -> return value -- | Get the sections in the config. sections :: Ini -> [Text] sections (Ini ini) = M.keys ini -- | Get the keys in a section. keys :: Text -> Ini -> Either String [Text] keys name (Ini ini) = case M.lookup name ini of Nothing -> Left ("Couldn't find section: " ++ T.unpack name) Just section -> Right (M.keys section) -- | Read a value using a reader from "Data.Text.Read". readValue :: Text -> Text -> (Text -> Either String (a, Text)) -> Ini -> Either String a readValue section key f ini = lookupValue section key ini >>= f >>= return . fst -- | Parse a value using a reader from "Data.Attoparsec.Text". parseValue :: Text -> Text -> Parser a -> Ini -> Either String a parseValue section key f ini = lookupValue section key ini >>= parseOnly (f <* (skipSpace >> endOfInput)) -- | Print the INI config to a file. writeIniFile :: FilePath -> Ini -> IO () writeIniFile = writeIniFileWith defaultWriteIniSettings -- | Print an INI config. printIni :: Ini -> Text printIni = printIniWith defaultWriteIniSettings -- | Either @:@ or @=@. data KeySeparator = ColonKeySeparator | EqualsKeySeparator deriving (Eq, Show) -- | Settings determining how an INI file is written. data WriteIniSettings = WriteIniSettings { writeIniKeySeparator :: KeySeparator } deriving (Show) -- | The default settings for writing INI files. defaultWriteIniSettings :: WriteIniSettings defaultWriteIniSettings = WriteIniSettings { writeIniKeySeparator = ColonKeySeparator } -- | Print the INI config to a file. writeIniFileWith :: WriteIniSettings -> FilePath -> Ini -> IO () writeIniFileWith wis fp = T.writeFile fp . printIniWith wis -- | Print an INI config. printIniWith :: WriteIniSettings -> Ini -> Text printIniWith wis (Ini ini) = T.concat (map buildSection (M.toList ini)) where buildSection (name,pairs) = "[" <> name <> "]\n" <> T.concat (map buildPair (M.toList pairs)) buildPair (name,value) = name <> separator <> value <> "\n" separator = case writeIniKeySeparator wis of ColonKeySeparator -> ": " EqualsKeySeparator -> "=" -- | Parser for an INI. iniParser :: Parser Ini iniParser = fmap (Ini . M.fromList) (many sectionParser) -- | A section. Format: @[foo]@. Conventionally, @[FOO]@. sectionParser :: Parser (Text,HashMap Text Text) sectionParser = do skipEndOfLine skipComments skipEndOfLine _ <- char '[' name <- takeWhile (\c -> c /=']' && c /= '[') _ <- char ']' skipEndOfLine values <- many keyValueParser return (T.strip name, M.fromList values) -- | A key-value pair. Either @foo: bar@ or @foo=bar@. keyValueParser :: Parser (Text,Text) keyValueParser = do skipEndOfLine skipComments skipEndOfLine key <- takeWhile1 (\c -> not (isDelim c || c == '[' || c == ']')) delim <- satisfy isDelim value <- fmap (clean delim) (takeWhile (not . isEndOfLine)) skipEndOfLine return (T.strip key, T.strip value) where clean ':' = T.drop 1 clean _ = id -- | Is the given character a delimiter? isDelim :: Char -> Bool isDelim x = x == '=' || x == ':' -- | Skip end of line and whitespace beyond. skipEndOfLine :: Parser () skipEndOfLine = skipWhile (\c -> isEndOfLine c) -- | Skip comments starting at the beginning of the line. skipComments :: Parser () skipComments = skipMany (do _ <- satisfy (\c -> c == ';' || c == '#') skipWhile (not . isEndOfLine) skipEndOfLine) ini-0.3.6/LICENSE0000644000000000000000000000270313264117123011474 0ustar0000000000000000Copyright (c) 2013, ini 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 ini nor the names of its 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 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. ini-0.3.6/Setup.hs0000644000000000000000000000005613264117123012122 0ustar0000000000000000import Distribution.Simple main = defaultMain ini-0.3.6/ini.cabal0000644000000000000000000000165313264117201012232 0ustar0000000000000000name: ini version: 0.3.6 synopsis: Quick and easy configuration files in the INI format. description: Quick and easy configuration files in the INI format. license: BSD3 license-file: LICENSE author: Chris Done maintainer: chrisdone@gmail.com homepage: http://github.com/chrisdone/ini bug-reports: http://github.com/chrisdone/ini/issues copyright: 2013 Chris Done category: Data, Configuration build-type: Simple cabal-version: >=1.8 library hs-source-dirs: src/ ghc-options: -Wall -O2 extensions: OverloadedStrings exposed-modules: Data.Ini build-depends: base >= 4 && <5, attoparsec, text, unordered-containers source-repository head type: git location: http://github.com/chrisdone/ini.git