Konf.hs

--------------------------------------------------------------------------------
-- |
-- Module      : Text.Konf
-- Copyright   : (C) 2013 Göktuğ Kayaalp
-- License     : Two Clause BSD License (see file LICENSE)
--
-- Maintainer  : Göktuğ Kayaalp <self@gkayaalp.com>
-- Stability   : Experimental
-- Portability : Not known
--------------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- @Text.Konf@ is an implementation of the Konf language.
module Text.Konf
( Konf
, KonfValue(..)
, KonfException(..)
, konf
, konfFile
, lookup ) where

import Prelude hiding (lookup)
import Text.ParserCombinators.Parsec
import Text.Parsec.Error
import qualified Control.Exception as CE
import qualified Control.Monad as CM
import qualified Data.Map.Lazy as DML
import qualified Data.Typeable as DT

-- |
-- This data type enumerates the possible types a returned value may be.
-- Any value will be returned as a @KonfValue value@.
data KonfValue = KonfString String
               | KonfNumber Float
               | KonfComplex Float Float
               | KonfBoolean Bool
               | KonfIdentifier String
               | KonfList [KonfValue]
               | KonfUndefined
               deriving Show

-- |
-- The @Konf@ data type, a map from strings to values. This is actually a
-- parameterized @Data.Map.Lazy.Map@ and it is possible to use method in that
-- module on this type.
type Konf = DML.Map String KonfValue

data KonfException = SyntaxError String
                     deriving (Show, DT.Typeable)

instance CE.Exception KonfException

parseIdentifier :: Parser String
parseIdentifier = letter >>= \initial -> 
                    many alphaNum >>= \rest -> return (initial : rest)

parseFloat :: Parser KonfValue
parseFloat = many1 digit >>= \d ->
               -- `optionMaybe p' tries `p', if fails w/o consuming input,
               -- returns `Nothing'.  If a number lacks a decimal part (this
               -- parser return `Nothing'), it is appended `.0', thus
               -- combining the parsing of numbers in one parser and making it
               -- possible the complex number literal include integers w/o
               -- modifying it.
               optionMaybe decimalPart >>= \f ->
                 return $ KonfNumber $ read
                   (case f of
                     Just dp -> (d ++ "." ++ dp)
                     Nothing -> (d ++ ".0"))
        -- Parse `.' here to let the parser fail w/o consuming input if the
        -- literal has no decimal part.
  where decimalPart = char '.' >> many1 digit --  >>= return

parseComplex :: Parser KonfValue
parseComplex = parseFloat >>= \ (KonfNumber r) ->
                 skip >> char '+' >> skip >> parseFloat >>= \ (KonfNumber i) ->
                   (char 'i' <|> char 'j') >> return (KonfComplex r i)
  where skip = skipMany $ oneOf " \t"

parseNumber :: Parser KonfValue
parseNumber = try parseComplex <|> try parseFloat
               
parseBoolean :: Parser KonfValue
parseBoolean = true <|> false
  where
    true  = string "true"  >> return (KonfBoolean True)
    false = string "false" >> return (KonfBoolean False)

parseString :: Parser KonfValue
parseString = begin >>= \open ->
                many (noneOf "\\\"'" <|> escape) >>= \str ->
                  end open >> (return . KonfString) str
  where begin = oneOf "\"'"
        end character = char character
        escapeChar 'n' = '\n'
        escapeChar 't' = '\t'
        escapeChar 'r' = '\r'
        escapeChar 'b' = '\b'
        escapeChar  e  =  e
        escape = char '\\' >> letter >>= return . escapeChar

parseIdentifierRValue :: Parser KonfValue
parseIdentifierRValue = return . KonfIdentifier =<< parseIdentifier

parseList :: Parser KonfValue
parseList = open >> sepBy value comma >>= \l ->
              close >> return (KonfList l)
  where skip = skipMany $ oneOf " \t\n"
        open = char '(' >> skip >> optional comment >> skip
        close = skip >> optional comment >> skip >> char ')'
        value = parseValue >>= \v ->
                  skip >> optional comment >> skip >> return v
        comma = char ',' >> skip >> optional comment >> skip

comment :: Parser ()
comment = CM.void (char '#' >> manyTill anyChar newline)

parseValue :: Parser KonfValue
parseValue = parseList <|> parseString <|> parseNumber <|> try parseBoolean <|> parseIdentifierRValue

parsePair :: Parser (String, KonfValue)
parsePair = identifier >>= \key -> 
              equals >> parseValue >>= \value ->
                skip >> return (key, value)
  where skip = many $ oneOf " \t"
        equals = skip >> char '=' >> skip
        identifier = skip >> parseIdentifier

parsePairs :: Parser [(String, KonfValue)]
parsePairs = many getPair
  where skip = comment <|> CM.void newline
        terminate = (comment <|> CM.void (many1 newline)) >> optional eof
        getPair = many skip >> parsePair >>= \pair ->
                    terminate >> return pair

showErr :: ParseError -> String
showErr = show

-- |
-- Parse the string and return the resulting @Konf@ object, that can be
-- looked up for keys by using the @lookup@ function.
konf :: String -- ^ A string in the language of Konf.
     -> Konf   -- ^ A specialized map, as the result of parsing.
konf file = DML.fromList pairs
  -- HACK: I bet appending a newline to the end of the string is the silliest hack ever.
  where pairs = case parse parsePairs "konf" (file ++ "\n") of
                  -- TODO: Don't `show' here, build the string by the error resources of parsec.
                  Left err -> CE.throw $ SyntaxError ("Syntax error: " ++ showErr err)
                  Right kvlist -> kvlist

-- |
-- Read a file and parse; then return the result as a @Konf@ object in the IO monad.
konfFile :: FilePath -> IO Konf
konfFile f = do str <- readFile f
                return $ konf str


-- |
-- Lookup keys in the Konf object.
--
-- This is actually @Data.Map.Lazy.lookup@, but it additionally handles
-- mapped to other identifiers, by recursively looking those keys up
-- until it finds a value.
lookup :: Konf -> String -> KonfValue
lookup k key = case DML.lookup key k of
                 Just (KonfIdentifier i) -> lookup k i
                 Just value              -> value
                 Nothing                 -> KonfUndefined