diff --git a/src/FeedReader/Console.hs b/src/FeedReader/Console.hs index 7ced10e..94757cf 100644 --- a/src/FeedReader/Console.hs +++ b/src/FeedReader/Console.hs @@ -36,20 +36,21 @@ helpMessage = do yield " getk t k: SELECT * FROM t WHERE UniqueKey = k" yield " : t: 'feed', 'person' or 'item'" yield " : UniqueKey: 'URL', 'Name' or 'URL'" - yield " range p t c s" - yield " : SELECT TOP p * FROM t WHERE c < s ORDER BY c DESC" + yield " range p t c s z" + yield " : SELECT TOP p * FROM t WHERE c < s ORDER BY c z" yield " : c: '*' will use a default column" yield " : s: for date columns, start with 'D:' and replace ' ' with '_'" - yield " : s: for string columns, start with 'S:' (only first 4 chars matter)" + yield " : s: for string columns, start with 'S:'" yield " : s: use '*' to start at the top" - yield " filter p t c k o s" - yield " : SELECT TOP p * FROM t WHERE c = k AND o < s ORDER BY o DESC" + yield " : z: ASC or DESC" + yield " filter p t c k o s z" + yield " : SELECT TOP p * FROM t WHERE c = k AND o < s ORDER BY o z" yield " add n t : inserts n random records into the DB (t as above)" yield " cat n p : inserts a category" yield " : n: name" yield " : p: parent ID" yield " del k : deletes document with ID = k" - yield " range_del p t c s" + yield " range_del p t c s z" yield " : deletes a range of documents starting at k" yield " : params as in 'range'" yield " gc : performs GC" @@ -73,12 +74,12 @@ processCommand h = do "stats" -> doAbortable 0 args h cmdStats "get" -> doAbortable 2 args h cmdGet "getk" -> doAbortable 2 args h cmdGetk - "range" -> doAbortable 4 args h cmdRange - "filter" -> doAbortable 6 args h cmdFilter + "range" -> doAbortable 5 args h cmdRange + "filter" -> doAbortable 7 args h cmdFilter "add" -> doAbortable 2 args h cmdAdd "cat" -> doAbortable 2 args h cmdAddCat "del" -> doAbortable 1 args h cmdDel - "range_del" -> doAbortable 4 args h cmdRangeDel + "range_del" -> doAbortable 5 args h cmdRangeDel "gc" -> doAbortable 0 args h cmdGC "debug" -> doAbortable 2 args h cmdDebug "curl" -> doAbortable 1 args h cmdCurl @@ -257,14 +258,15 @@ cmdGetk h args = timed $ do :: LookupUnqRet Item) >>= out . fmap (show . snd) _ -> yield . shows t $ " is not a valid table name." -page h c p s mk o now dft = handleAbort $ - maybe (DB.runRange h p (fromString fprop) (parseVal s now)) +page h c p s mk o now dft z = handleAbort $ + maybe (DB.runRange h p (fromString fprop) (parseVal s now) so) (\k -> DB.runFilterRange h p (fromString fprop) (nk k) - (fromString oprop)(parseVal s now)) + (fromString oprop)(parseVal s now) so) mk where fprop = if c == "*" then dft else c oprop = if o == "*" then dft else o nk k = if k == 0 then Nothing else Just $ fromIntegral (k :: Int) + so = if z == "ASC" then DB.SortAsc else DB.SortDesc parseVal s now | "D:" `isPrefixOf` s = Just . DB.Sortable . DB.toKey . DB.Sortable $ @@ -274,7 +276,7 @@ parseVal s now | otherwise = Just . DB.Sortable . DB.toKey . DB.Sortable $ (read s :: Int) -cmdPage h args s mk o = do +cmdPage h args s mk o z = do let p = (read $ args !! 1) :: Int let t = args !! 2 let c = args !! 3 @@ -286,22 +288,22 @@ cmdPage h args s mk o = do now <- DB.DateTime <$> liftBase getCurrentTime case t of "cat" -> do - (as, dt) <- timeOf $ page h c p s mk o now "catName" + (as, dt) <- timeOf $ page h c p s mk o now "catName" z yields $ format "Id" . showString "Name" each $ sCat <$> as showTime dt "feed" -> do - (as, dt) <- timeOf $ page h c p s mk o now "feedUpdated" + (as, dt) <- timeOf $ page h c p s mk o now "feedUpdated" z yields $ format "Id" . format "Category" . showString "Updated" each $ sFeed <$> as showTime dt "person" -> do - (as, dt) <- timeOf $ page h c p s mk o now "personName" + (as, dt) <- timeOf $ page h c p s mk o now "personName" z yields $ format "Id" . showString "Name" each $ sPerson <$> as showTime dt "item" -> do - (as, dt) <- timeOf $ page h c p s mk o now "itemUpdated" + (as, dt) <- timeOf $ page h c p s mk o now "itemUpdated" z showItems h as showTime dt _ -> yield . shows t $ " is not a valid table name." @@ -336,13 +338,15 @@ showItems h as = do cmdRange h args = do let s = args !! 4 - cmdPage h args s Nothing "" + let z = args !! 5 + cmdPage h args s Nothing "" z cmdFilter h args = do let k = (read $ args !! 4) :: Int let o = args !! 5 let s = args !! 6 - cmdPage h args s (Just k) o + let z = args !! 7 + cmdPage h args s (Just k) o z showIDs is = do let ids = map show is @@ -367,7 +371,7 @@ cmdAdd h args = timed $ do randomPerson >>= DB.runInsert h) >>= showIDs "feed" -> do - cs' <- handleAbort $ DB.runRange h maxBound "catName" nothing + cs' <- handleAbort $ DB.runRange h maxBound "catName" nothing DB.SortAsc let cs = S.fromList cs' let rs = take n $ randomRs (0, S.length cs - 1) g fs <- handleAbort $ liftM sequence . P.toListM . for (each rs) $ \r -> @@ -376,7 +380,7 @@ cmdAdd h args = timed $ do yield showIDs fs "item" -> do - fs' <- handleAbort $ DB.runRange h maxBound "feedUpdated" nothing + fs' <- handleAbort $ DB.runRange h maxBound "feedUpdated" nothing DB.SortAsc let fs = S.fromList fs' let rfids = (fst . S.index fs) <$> take n (randomRs (0, S.length fs - 1) g) stNew <- handleAbort . DB.runQuery h $ DB.itemStatusByKey StatusNew @@ -407,17 +411,19 @@ cmdRangeDel h args = timed $ do let p = (read $ args !! 1) :: Int let c = args !! 3 let s = args !! 4 + let z = args !! 5 + let so = if z == "ASC" then DB.SortAsc else DB.SortDesc now <- DB.DateTime <$> liftBase getCurrentTime sz <- maybe (yield "Explicit value required." >> return 0) (\k -> case t of - "cat" -> - handleAbort (DB.runDeleteRange h p (def c "catName" :: Property Cat ) k) - "feed" -> - handleAbort (DB.runDeleteRange h p (def c "feedUpdated" :: Property Feed ) k) - "person" -> - handleAbort (DB.runDeleteRange h p (def c "personName" :: Property Person) k) - "item" -> - handleAbort (DB.runDeleteRange h p (def c "itemUpdated" :: Property Item ) k) + "cat" -> handleAbort (DB.runDeleteRange h p + (def c "catName" :: Property Cat ) k so) + "feed" -> handleAbort (DB.runDeleteRange h p + (def c "feedUpdated" :: Property Feed ) k so) + "person" -> handleAbort (DB.runDeleteRange h p + (def c "personName" :: Property Person) k so) + "item" -> handleAbort (DB.runDeleteRange h p + (def c "itemUpdated" :: Property Item ) k so) _ -> yield (shows t " is not a valid table name.") >> return 0) (parseVal s now) yields $ shows sz . showString " records deleted." diff --git a/src/FeedReader/DB.hs b/src/FeedReader/DB.hs index 7163265..7505591 100644 --- a/src/FeedReader/DB.hs +++ b/src/FeedReader/DB.hs @@ -50,16 +50,16 @@ runUnique :: (Document a, ToKey (Unique b), LogState l, MonadIO m) => runUnique h p k = runQuery h $ unique p k runRange :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => - Handle l -> Int -> Property a -> Maybe (Sortable b) -> + Handle l -> Int -> Property a -> Maybe (Sortable b) -> SortOrder -> m (Either TransactionAbort [(Reference a, a)]) -runRange h pg prop s = runQuery h $ range pg prop s Nothing +runRange h pg prop s so = runQuery h $ range pg prop s Nothing so runFilterRange :: (Document a, ToKey (Sortable c), LogState l, MonadIO m) => Handle l -> Int -> Property a -> Maybe (Reference b) -> - Property a -> Maybe (Sortable c) -> + Property a -> Maybe (Sortable c) -> SortOrder -> m (Either TransactionAbort [(Reference a, a)]) -runFilterRange h pg fprop k sprop s = runQuery h $ - filterRange pg fprop k sprop s Nothing +runFilterRange h pg fprop k sprop s so = runQuery h $ + filterRange pg fprop k sprop s Nothing so runInsert :: (Document a, LogState l, MonadIO m) => Handle l -> a -> m (Either TransactionAbort (Reference a)) @@ -74,16 +74,16 @@ runDelete :: (LogState l, MonadIO m) => runDelete h did = runQuery h (delete did) deleteRange :: (Document a, ToKey (Sortable b), MonadIO m) => - Int -> Property a -> Sortable b -> Transaction l m Int -deleteRange pg prop s = do - ks <- range' pg prop (Just s) Nothing + Int -> Property a -> Sortable b -> SortOrder -> Transaction l m Int +deleteRange pg prop s so = do + ks <- range' pg prop (Just s) Nothing so forM_ ks $ \k -> delete k return $ length ks runDeleteRange :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => - Handle l -> Int -> Property a -> Sortable b -> + Handle l -> Int -> Property a -> Sortable b -> SortOrder -> m (Either TransactionAbort Int) -runDeleteRange h pg prop s = runQuery h (deleteRange pg prop s) +runDeleteRange h pg prop s so = runQuery h (deleteRange pg prop s so) data DBStats = DBStats { countCats :: Int diff --git a/src/FeedReader/Import.hs b/src/FeedReader/Import.hs index 8419947..cb66ba1 100644 --- a/src/FeedReader/Import.hs +++ b/src/FeedReader/Import.hs @@ -87,12 +87,14 @@ writeFeed h f fid feed = F.AtomFeed af -> runToFeed h af fid feed F.RSSFeed rss -> runToFeed h (R.rssChannel rss) fid feed F.RSS1Feed rf -> runToFeed h rf fid feed + F.XMLFeed _ -> error "Impossibru" >>= either (return . Left) (\feed' -> liftM (liftM (Just feed',) . sequence) $ case f of F.AtomFeed af -> addItems $ A.feedEntries af F.RSSFeed rss -> addItems . R.rssItems $ R.rssChannel rss - F.RSS1Feed rf -> addItems $ R1.feedItems rf) + F.RSS1Feed rf -> addItems $ R1.feedItems rf + F.XMLFeed _ -> error "Impossibru" ) where addItems is = P.toListM $ for (each is) $ \i -> lift (runToItem h i fid) >>= yield @@ -130,7 +132,7 @@ importOPML h p = do opmlToDb :: (LogState l, MonadIO m) => Maybe (Reference Cat) -> [Outline] -> Transaction l m [(Reference Feed, Feed)] opmlToDb pcat os = do - cs <- filter "catName" pcat "catName" + cs <- filter "catName" pcat "catName" SortAsc rss <- forM os $ \o -> case parseOutline o of Left str -> if null str then return [] else do cid <- case find ((== opmlText o) . unSortable . catName . snd) cs of diff --git a/src/FeedReader/Types.hs b/src/FeedReader/Types.hs index 2fe6347..b03182c 100644 --- a/src/FeedReader/Types.hs +++ b/src/FeedReader/Types.hs @@ -93,9 +93,7 @@ data Feed = Feed -- TODO: Sortable -> Sorted, Reference -> Ref -- TODO: filter on Sorted columns -- TODO: File backend: process file locking --- TODO: sort the other way -- TODO: optimize getDocument (hash id => multiple caches) --- TODO: add the rest of _K functions instance Document Feed