{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}
-- |
-- Module: NetSpider.GraphML.Attribute
-- Description: GraphML attribute types
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- @since 0.4.1.0
module NetSpider.GraphML.Attribute
  ( AttributeKey,
    AttributeValue(..),
    ToAttributes(..),
    valueFromAeson,
    attributesFromAeson,
    attributesToAeson
  ) where

import Control.Applicative (empty)
import Data.Aeson (FromJSON(..), ToJSON(..))
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Scientific as Sci
import Data.Text (Text, pack)
import Data.Time (TimeZone(..))

-- | Key of attribute.
type AttributeKey = Text

-- | Typed value of attribute.
data AttributeValue = AttrBoolean Bool
                    | AttrInt Int
                    | AttrLong Integer
                    | AttrFloat Float
                    | AttrDouble Double
                    | AttrString Text
                    deriving (Int -> AttributeValue -> ShowS
[AttributeValue] -> ShowS
AttributeValue -> String
(Int -> AttributeValue -> ShowS)
-> (AttributeValue -> String)
-> ([AttributeValue] -> ShowS)
-> Show AttributeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValue] -> ShowS
$cshowList :: [AttributeValue] -> ShowS
show :: AttributeValue -> String
$cshow :: AttributeValue -> String
showsPrec :: Int -> AttributeValue -> ShowS
$cshowsPrec :: Int -> AttributeValue -> ShowS
Show,AttributeValue -> AttributeValue -> Bool
(AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> Bool) -> Eq AttributeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValue -> AttributeValue -> Bool
$c/= :: AttributeValue -> AttributeValue -> Bool
== :: AttributeValue -> AttributeValue -> Bool
$c== :: AttributeValue -> AttributeValue -> Bool
Eq,Eq AttributeValue
Eq AttributeValue
-> (AttributeValue -> AttributeValue -> Ordering)
-> (AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> AttributeValue)
-> (AttributeValue -> AttributeValue -> AttributeValue)
-> Ord AttributeValue
AttributeValue -> AttributeValue -> Bool
AttributeValue -> AttributeValue -> Ordering
AttributeValue -> AttributeValue -> AttributeValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttributeValue -> AttributeValue -> AttributeValue
$cmin :: AttributeValue -> AttributeValue -> AttributeValue
max :: AttributeValue -> AttributeValue -> AttributeValue
$cmax :: AttributeValue -> AttributeValue -> AttributeValue
>= :: AttributeValue -> AttributeValue -> Bool
$c>= :: AttributeValue -> AttributeValue -> Bool
> :: AttributeValue -> AttributeValue -> Bool
$c> :: AttributeValue -> AttributeValue -> Bool
<= :: AttributeValue -> AttributeValue -> Bool
$c<= :: AttributeValue -> AttributeValue -> Bool
< :: AttributeValue -> AttributeValue -> Bool
$c< :: AttributeValue -> AttributeValue -> Bool
compare :: AttributeValue -> AttributeValue -> Ordering
$ccompare :: AttributeValue -> AttributeValue -> Ordering
$cp1Ord :: Eq AttributeValue
Ord)

-- | Based on 'valueFromAeson'.
--
-- @since 0.4.1.0
instance FromJSON AttributeValue where
  parseJSON :: Value -> Parser AttributeValue
parseJSON Value
v = Parser AttributeValue
-> (AttributeValue -> Parser AttributeValue)
-> Maybe AttributeValue
-> Parser AttributeValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser AttributeValue
forall (f :: * -> *) a. Alternative f => f a
empty AttributeValue -> Parser AttributeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AttributeValue -> Parser AttributeValue)
-> Maybe AttributeValue -> Parser AttributeValue
forall a b. (a -> b) -> a -> b
$ Value -> Maybe AttributeValue
valueFromAeson Value
v

-- | @since 0.4.1.0
instance ToJSON AttributeValue where
  toJSON :: AttributeValue -> Value
toJSON AttributeValue
v =
    case AttributeValue
v of
      AttrBoolean Bool
b -> Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b
      AttrInt Int
i -> Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
      AttrLong Integer
l -> Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
l
      AttrFloat Float
f -> Float -> Value
forall a. ToJSON a => a -> Value
toJSON Float
f
      AttrDouble Double
d -> Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
d
      AttrString Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t

-- | Type that can be converted to list of attributes.
class ToAttributes a where
  toAttributes :: a -> [(AttributeKey, AttributeValue)]

instance ToAttributes () where
  toAttributes :: () -> [(Text, AttributeValue)]
toAttributes ()
_ = []

instance ToAttributes [(AttributeKey, AttributeValue)] where
  toAttributes :: [(Text, AttributeValue)] -> [(Text, AttributeValue)]
toAttributes = [(Text, AttributeValue)] -> [(Text, AttributeValue)]
forall a. a -> a
id

-- | 'Nothing' is mapped to empty attributes.
instance ToAttributes a => ToAttributes (Maybe a) where
  toAttributes :: Maybe a -> [(Text, AttributeValue)]
toAttributes Maybe a
Nothing = []
  toAttributes (Just a
a) = a -> [(Text, AttributeValue)]
forall a. ToAttributes a => a -> [(Text, AttributeValue)]
toAttributes a
a

-- | @since 0.4.1.0
instance ToAttributes TimeZone where
  toAttributes :: TimeZone -> [(Text, AttributeValue)]
toAttributes TimeZone
tz =
    [ (Text
"@tz_offset_min", Int -> AttributeValue
AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ TimeZone -> Int
timeZoneMinutes TimeZone
tz),
      (Text
"@tz_summer_only", Bool -> AttributeValue
AttrBoolean (Bool -> AttributeValue) -> Bool -> AttributeValue
forall a b. (a -> b) -> a -> b
$ TimeZone -> Bool
timeZoneSummerOnly TimeZone
tz),
      (Text
"@tz_name", Text -> AttributeValue
AttrString (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeZone -> String
timeZoneName TimeZone
tz)
    ]

-- | Make 'AttributeValue' from aeson's 'Aeson.Value'. It returns
-- 'Nothing', if the input is null, an object or an array. If the
-- input is a number, the output uses 'AttrDouble'.
valueFromAeson :: Aeson.Value -> Maybe AttributeValue
valueFromAeson :: Value -> Maybe AttributeValue
valueFromAeson Value
v =
  case Value
v of
    Aeson.String Text
t -> AttributeValue -> Maybe AttributeValue
forall a. a -> Maybe a
Just (AttributeValue -> Maybe AttributeValue)
-> AttributeValue -> Maybe AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
AttrString Text
t
    Aeson.Bool Bool
b -> AttributeValue -> Maybe AttributeValue
forall a. a -> Maybe a
Just (AttributeValue -> Maybe AttributeValue)
-> AttributeValue -> Maybe AttributeValue
forall a b. (a -> b) -> a -> b
$ Bool -> AttributeValue
AttrBoolean Bool
b
    Aeson.Number Scientific
n -> AttributeValue -> Maybe AttributeValue
forall a. a -> Maybe a
Just (AttributeValue -> Maybe AttributeValue)
-> AttributeValue -> Maybe AttributeValue
forall a b. (a -> b) -> a -> b
$ Double -> AttributeValue
AttrDouble (Double -> AttributeValue) -> Double -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat Scientific
n
    Value
_ -> Maybe AttributeValue
forall a. Maybe a
Nothing

-- | Make attributes from aeson's 'Aeson.Value'. It assumes the input
-- is an object, and its values can be converted by
-- 'valueFromAeson'. Otherwise, it returns 'Nothing'.
attributesFromAeson :: Aeson.Value -> Maybe [(AttributeKey, AttributeValue)]
attributesFromAeson :: Value -> Maybe [(Text, AttributeValue)]
attributesFromAeson Value
v =
  case Value
v of
    Aeson.Object Object
o -> ((Text, Value) -> Maybe (Text, AttributeValue))
-> [(Text, Value)] -> Maybe [(Text, AttributeValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Value) -> Maybe (Text, AttributeValue)
forall a. (a, Value) -> Maybe (a, AttributeValue)
convElem ([(Text, Value)] -> Maybe [(Text, AttributeValue)])
-> [(Text, Value)] -> Maybe [(Text, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o
    Value
_ -> Maybe [(Text, AttributeValue)]
forall a. Maybe a
Nothing
  where
    convElem :: (a, Value) -> Maybe (a, AttributeValue)
convElem (a
k, Value
val) = (AttributeValue -> (a, AttributeValue))
-> Maybe AttributeValue -> Maybe (a, AttributeValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) a
k) (Maybe AttributeValue -> Maybe (a, AttributeValue))
-> Maybe AttributeValue -> Maybe (a, AttributeValue)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe AttributeValue
valueFromAeson Value
val

-- | Make aeson 'Aeson.Object' as 'Aeson.Value' from attributes.
--
-- @since 0.4.1.0
attributesToAeson :: [(AttributeKey, AttributeValue)] -> Aeson.Value
attributesToAeson :: [(Text, AttributeValue)] -> Value
attributesToAeson = Object -> Value
Aeson.Object (Object -> Value)
-> ([(Text, AttributeValue)] -> Object)
-> [(Text, AttributeValue)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Value)] -> Object)
-> ([(Text, AttributeValue)] -> [(Text, Value)])
-> [(Text, AttributeValue)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, AttributeValue) -> (Text, Value))
-> [(Text, AttributeValue)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Text, AttributeValue) -> (Text, Value))
 -> [(Text, AttributeValue)] -> [(Text, Value)])
-> ((AttributeValue -> Value)
    -> (Text, AttributeValue) -> (Text, Value))
-> (AttributeValue -> Value)
-> [(Text, AttributeValue)]
-> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttributeValue -> Value)
-> (Text, AttributeValue) -> (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) AttributeValue -> Value
forall a. ToJSON a => a -> Value
toJSON