muesli refactoring

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."

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

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

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