-import_generic :: (XmlPickler a, MonadIO m, PersistEntity b, PersistBackend m)
- => b -- ^ Dummy Listing instance needed for 'migrate'
- -> (a -> [b]) -- ^ listings getter
- -> XmlTree
- -> m (Maybe Int) -- ^ Return the number of records inserted.
-import_generic dummy g xml = do
- -- Needs NoMonomorphismRestriction to be allowed to return
- -- different types in the two cases above.
- runMigration defaultMigrationLogger $ migrate dummy
- let root_element = unpickleDoc xpickle xml
- case root_element of
- Nothing -> do
- let msg = "Could not unpickle document in import_generic."
- liftIO $ report_error msg
- return Nothing
- Just elt -> do
- ids <- mapM insert (g elt)
- return $ Just (length ids)
-
-
-
--- | Import TSN.News from an 'XmlTree'.
-import_news :: (MonadIO m, PersistBackend m)
- => XmlTree
- -> m (Maybe Int)
-import_news = -- This implementation is wrroooonnnnngggg.
- import_generic
- (undefined :: News.Message)
- (\m -> [m] :: [News.Message]) -- Turn a Message into a [Message]
-
--- | Import TSN.Injuries from an 'XmlTree'.
-import_injuries :: (MonadIO m, PersistBackend m)
- => XmlTree
- -> m (Maybe Int)
-import_injuries =
- import_generic
- (undefined :: Injuries.Listing)
- Injuries.listings
-
--- | Import TSN.InjuriesDetail from an 'XmlTree'.
-import_injuries_detail :: (MonadIO m, PersistBackend m)
- => XmlTree
- -> m (Maybe Int)
-import_injuries_detail =
- import_generic
- (undefined :: InjuriesDetail.PlayerListing)
- ( (concatMap InjuriesDetail.player_listings) . InjuriesDetail.listings)
-
-import_file :: Configuration -> FilePath -> IO ()
-import_file cfg path = do
- results <- catchIOError
- parse_and_import
- (\e -> do
- report_error (show e)
- report_error $ "Failed to import file " ++ path ++ "."
- -- Return a nonempty list so we don't claim incorrectly that
- -- we couldn't parse the DTD.
- return [ Nothing ] )
+-- The implementation is straightforward with one exception: since
+-- we are already in arrow world with HXT, the @import_with_dtd@
+-- function is lifted to an 'Arrow' as well with 'arr'. This
+-- prevents us from having to do a bunch of unwrapping and
+-- rewrapping with the associated error checking.
+--
+import_file :: Configuration -- ^ A configuration object needed for the
+ -- 'backend' and 'connection_string'.