packages feed

bini-0.1.3: src/Data/Bini.hs


-- | Compressed binary configuration files in the (B)INI format.
--
--
-- Parsing example:
--
-- @
-- r <- readBiniFromFile \"loadouts.ini\"
-- case r of
--  Left s -> print s
--  Right bini -> writeFile \"loadouts.ini.txt\" (show bini)
-- @
--
-- Outputfile:
--
-- @
-- [Loadout]
-- nickname = msn_playerloadout
-- archetype = ge_fighter
-- equip = ge_gf1_engine_01
-- equip = shield01_mark01_lf, HpShield01
-- equip = ge_fighter_power01
-- ...
-- @


module Data.Bini
    (-- * Reading
    readBiniFromFile,
    -- * Types
    Bini(..),
    Section(..),
    Entry(..),
    BiniVal(..)) where

import qualified Data.ByteString.Lazy as BL
import Data.Binary.Get
import Data.Word
--import Data.Binary
import Data.Int
import Data.List(intercalate)

--helper

bstr2str :: BL.ByteString -> String
bstr2str = tail.init.show

-- |Get a String from the stringtable
getOffset :: BL.ByteString -> Int -> BL.ByteString
getOffset bstr offset = BL.takeWhile (\c-> not $ c==0) s where
                        (_,s) = BL.splitAt (fromIntegral offset) bstr

--datatypes

-- |The abstract representation of the Bini
data Bini = Bini{ version :: Int, sections :: [Section] }

-- |The abstract representation of a section
data Section = Section{ name :: String, entries :: [Entry] }

-- |The abstract representation of an entry
data Entry = Entry String [BiniVal]

-- |The abstract representation of a bini-value
data BiniVal = BiniInt Int | BiniFloat Float | BiniString String



instance Show Bini where
    show (Bini v secs) = intercalate "\n" (map show secs)

instance Show Section where
    show (Section name entries) = "["++name++"]\n"++(intercalate "\n" (map show entries))++"\n"

instance Show Entry where
    show (Entry name vals) = name++" = "++(intercalate ", " (map show vals))

instance Show BiniVal where
    show (BiniInt i) = show i
    show (BiniFloat f) = show f
    show (BiniString s) = s


-- |Parse a Binifile
-- |Parse a Binifile
readBiniFromFile :: String -> IO (Either String Bini)
readBiniFromFile path = do
    content <- BL.readFile path
    let (isBini, version, strtableoff) = runGet parseHeader content
    if "BINI"== bstr2str (BL.take 4 content) then do
        let (header_body, table) = BL.splitAt (fromIntegral strtableoff) content
        let body = BL.drop 12 header_body
        let secs = runGet (parseSections table) body
        return $ Right $ Bini version secs
    else do
        return $ Left $ path++"is not a Bini-file!"


--Parsing the Bini-file:

-- |Parse an entry
parseEntry :: BL.ByteString -> Get Entry
parseEntry ls = do
    stroffset <- getWord16le
    n_vals <- getWord8
    let entryname = bstr2str $ ls `getOffset` (fromIntegral stroffset)
    vals <- sequence [parseVal ls | x<-[1..(fromIntegral n_vals)]]
    return (Entry entryname vals)

-- |Parse an entry-value
parseVal :: BL.ByteString -> Get BiniVal
parseVal ls = do
    typ <- getWord8
    dat <- getWord32le
    let val = case (fromIntegral typ) of
                1 -> BiniInt $ fromIntegral dat
                2 -> BiniFloat $ fromIntegral dat
                3 -> BiniString $ bstr2str $ ls `getOffset` (fromIntegral dat)
    return val

parseSection :: BL.ByteString -> Get Section
parseSection table = do
    stroffset <- getWord16le
    num_e <- getWord16le
    let secname = bstr2str $ table `getOffset` (fromIntegral stroffset)
    let num_entries = fromIntegral num_e
    entries <- sequence [parseEntry table | x<-[1..num_entries]]
    return Section{ name = secname, entries = entries }

parseSections :: BL.ByteString -> Get [Section]
parseSections table = do
    b <- isEmpty
    if b then do
        return []
    else do
        sec <- parseSection table
        b2 <- isEmpty
        if b2 then do
            return [sec]
        else do
            secs <- parseSections table
            return $ [sec]++secs

parseHeader :: Get (Word32, Int, Int)
parseHeader = do
    isBini <- getWord32le
    version <- getWord32le
    str_table_offset <- getWord32le
    return (isBini, fromIntegral version, fromIntegral str_table_offset)