{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}
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(..))
type AttributeKey = Text
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)
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
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
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
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
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)
]
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
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
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