-mergeNmcDom 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 -> Maybe a) -> Maybe a
- choose field = case field dom of
- Nothing -> field sub
- Just x -> Just x
-
--- | Perform query and return error string or parsed domain object
-queryNmcDom ::
- (String -> IO (Either String ByteString)) -- ^ query operation action
- -> String -- ^ key
- -> IO (Either String NmcDom) -- ^ error string or domain
-queryNmcDom queryOp key = do
- l <- queryOp key
- case l of
- Left estr -> return $ Left estr
- Right str -> case decode str :: Maybe NmcDom of
- Nothing -> return $ Left $ "Unparseable value: " ++ (show str)
- Just dom -> return $ Right dom
-
--- | Try to fetch "import" object and merge it into the base domain
--- In case of errors they are ignored, and nothing is merged.
--- Original "import" element is removed, but new imports from the
--- imported objects are processed recursively until there are none.
-mergeImport ::
- (String -> IO (Either String ByteString)) -- ^ query operation action
- -> NmcDom -- ^ base domain
- -> IO NmcDom -- ^ result with merged import
-mergeImport queryOp base = do
- let base' = base {domImport = Nothing}
- -- print base'
- case domImport base of
- Nothing -> return base'
- Just key -> do
- sub <- queryNmcDom queryOp key
- case sub of
- Left e -> return base'
- Right sub' -> mergeImport queryOp $ sub' `mergeNmcDom` base'