PropertyMap.hs

{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2016 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{-# LANGUAGE FlexibleInstances #-}

module Coin.Utils.PropertyMap (
    Property (..),
    PropertyMap,
    IsProperty,
    empty,
    insert,
    insertMaybe,
    delete,
    lookup,
    union
) where

import Prelude hiding (lookup)

import qualified Data.Map.Strict as Map

import Data.Binary

data Property = StringProperty String
              | IntProperty Int
              | MapProperty (Map.Map String Property)
              | IntListProperty [Int]
              | DateProperty (Integer, Int, Int)
              | BoolProperty Bool
              deriving Show

type PropertyMap = Map.Map String Property

class IsProperty a where
    toProperty   :: a -> Property
    fromProperty :: Property -> a

instance IsProperty String where
    toProperty = StringProperty
    fromProperty (StringProperty a) = a
    fromProperty x = error $ "instance IsProperty String: type conversion error.\n" ++ show x

instance IsProperty Int where
    toProperty = IntProperty
    fromProperty (IntProperty a) = a
    fromProperty x = error $ "instance IsProperty Int: type conversion error.\n" ++ show x

instance IsProperty (Map.Map String Property) where
    toProperty = MapProperty
    fromProperty (MapProperty a) = a
    fromProperty x = error $ "instance IsProperty Map: type conversion error.\n" ++ show x

instance IsProperty [Int] where
    toProperty = IntListProperty
    fromProperty (IntListProperty a) = a
    fromProperty x = error $ "instance IsProperty [Int]: type conversion error.\n" ++ show x

instance IsProperty (Integer, Int, Int) where
    toProperty = DateProperty
    fromProperty (DateProperty a) = a
    fromProperty x = error $ "instance IsProperty (Integer, Int, Int): type conversion error.\n" ++ show x

instance IsProperty Bool where
    toProperty = BoolProperty
    fromProperty (BoolProperty a) = a
    fromProperty x = error $ "instance IsProperty Bool: type conversion error.\n" ++ show x

instance Binary Property where
    put (StringProperty value)  = putWord8 255 >> put value
    put (IntProperty value)     = putWord8 254 >> put value
    put (MapProperty value)     = putWord8 253 >> put value
    put (IntListProperty value) = putWord8 252 >> put value
    put (DateProperty value)    = putWord8 251 >> put value
    put (BoolProperty value)    = putWord8 250 >> put value

    get = do
        t <- getWord8
        case t of
            255 -> StringProperty  <$> get
            254 -> IntProperty     <$> get
            253 -> MapProperty     <$> get
            252 -> IntListProperty <$> get
            251 -> DateProperty    <$> get
            250 -> BoolProperty    <$> get
            _   -> error "Error: PropertyMap.hs (instance Binary Property)."

empty :: PropertyMap
empty = Map.empty

insert :: IsProperty a => String -> a -> PropertyMap -> PropertyMap
insert key value = Map.insert key $ toProperty value

insertMaybe :: IsProperty a => String -> Maybe a -> PropertyMap -> PropertyMap
insertMaybe key value m =
    case value of
        Just value' -> insert key value' m
        Nothing     -> delete key m

delete :: String -> PropertyMap -> PropertyMap
delete = Map.delete

lookup :: IsProperty a => String -> PropertyMap -> Maybe a
lookup key m = fromProperty <$> Map.lookup key m

union :: PropertyMap -> PropertyMap -> PropertyMap
union = Map.union