) where
import Data.ByteString.Lazy (ByteString)
+import Data.Text as T (unpack)
import Data.Map as M (Map, lookup)
import Control.Applicative ((<$>), (<*>), empty)
import Data.Aeson
} deriving (Show, Eq)
instance FromJSON NmcDom where
+ -- Some just put the IP address in the value, especially in the map.
+ -- As an ugly hack, try to interpret string as IP (v4) address.
+ parseJSON (String s) = return emptyNmcDom { domIp = Just [T.unpack s] }
parseJSON (Object o) = NmcDom
<$> o .:? "service"
<*> o .:? "ip"
<*> o .: "expires_in"
parseJSON _ = empty
+normalizeDom :: NmcDom -> NmcDom
+normalizeDom dom
+ | domNs dom /= Nothing = emptyNmcDom { domNs = domNs dom
+ , domEmail = domEmail dom
+ }
+ | domDelegate dom /= Nothing = emptyNmcDom -- FIXME
+ | domTranslate dom /= Nothing = dom { domMap = Nothing }
+ | otherwise = dom
+
descendNmc :: [String] -> NmcDom -> NmcDom
-descendNmc subdom dom = case subdom of
- [] ->
- case domMap dom of
- Nothing -> dom
- Just map ->
- case M.lookup "" map of -- Stupid, but "" is allowed in the map
- Nothing -> dom -- Try to merge it with the root data
- Just sub -> mergeNmc sub dom
- d:ds ->
- case domMap dom of
- Nothing -> emptyNmcDom
- Just map ->
- case M.lookup d map of
- Nothing -> emptyNmcDom
- Just sub -> descendNmc ds sub
+descendNmc subdom rawdom =
+ let dom = normalizeDom rawdom
+ in case subdom of
+ [] ->
+ case domMap dom of
+ Nothing -> dom
+ Just map ->
+ case M.lookup "" map of -- Stupid, but there are "" in the map
+ Nothing -> dom -- Try to merge it with the root data
+ Just sub -> mergeNmc sub dom -- Or maybe drop it altogether...
+ d:ds ->
+ case domMap dom of
+ Nothing -> emptyNmcDom
+ Just map ->
+ case M.lookup d map of
+ Nothing -> emptyNmcDom
+ Just sub -> descendNmc ds sub
-- FIXME -- I hope there exists a better way to merge records!
mergeNmc :: NmcDom -> NmcDom -> NmcDom
-mergeNmc sub dom = dom { domService = choose dom domService sub
- , domIp = choose dom domIp sub
- , domIp6 = choose dom domIp6 sub
- , domTor = choose dom domTor sub
- , domI2p = choose dom domI2p sub
- , domFreenet = choose dom domFreenet sub
- , domAlias = choose dom domAlias sub
- , domTranslate = choose dom domTranslate sub
- , domEmail = choose dom domEmail sub
- , domLoc = choose dom domLoc sub
- , domInfo = choose dom domInfo sub
- , domNs = choose dom domNs sub
- , domDelegate = choose dom domDelegate sub
- , domImport = choose dom domImport sub
- , domFingerprint = choose dom domFingerprint sub
- , domTls = choose dom domTls sub
- , domDs = choose dom domDs sub
+mergeNmc sub dom = dom { domService = choose domService
+ , domIp = choose domIp
+ , domIp6 = choose domIp6
+ , domTor = choose domTor
+ , domI2p = choose domI2p
+ , domFreenet = choose domFreenet
+ , domAlias = choose domAlias
+ , domTranslate = choose domTranslate
+ , domEmail = choose domEmail
+ , domLoc = choose domLoc
+ , domInfo = choose domInfo
+ , domNs = choose domNs
+ , domDelegate = choose domDelegate
+ , domImport = choose domImport
+ , domFingerprint = choose domFingerprint
+ , domTls = choose domTls
+ , domDs = choose domDs
}
where
- choose :: NmcDom -> (NmcDom -> Maybe a) -> NmcDom -> Maybe a
- choose sub t dom = case t dom of
- Nothing -> t sub
+ choose :: (NmcDom -> Maybe a) -> Maybe a
+ choose field = case field dom of
+ Nothing -> field sub
Just x -> Just x