diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -25,7 +25,6 @@
 ```
 
 Then, the following runtime dependencies must be installed separately and provided in `PATH`:
-- [httpie](https://github.com/jakubroztocil/httpie)
 - [pup](https://github.com/ericchiang/pup)
 
 ## Configuration
@@ -34,7 +33,7 @@
 
 Callbacks are configured through the `$XDG_CONFIG_HOME/imm/callbacks.dhall` file. A commented template file is bundled with the project.
 
-*imm* will call each callback once per feed element, and will fill its standard input (`stdin`) with [Avro][4]-encoded binary data, which schema is described in file [`idl/callback.json`](idl/callback.json).
+*imm* will call each callback once per feed item, and will fill its standard input (`stdin`) with a JSON structure, which schema is described in file [`schema/imm.json`](schema/imm.json).
 
 Callback process is expected to return `0` in case of success, or any other exit code in case of failure, in which case the standard error output (`stderr`) will be displayed.
 
@@ -88,17 +87,12 @@
 
 - Subscribe to a feed through direct URL:
   ```bash
-  imm subscribe -u http://your.feed.org
+  imm subscribe http://your.feed.org
   ```
 
 - Subscribe to a feed through an alternate link:
   ```bash
-  imm subscribe -a http://your.website.org
-  ```
-
-- Import feeds from an OPML file:
-  ```bash
-  imm import < feeds.opml
+  imm subscribe http://your.website.org
   ```
 
 - List subscribed feeds:
@@ -108,12 +102,12 @@
 
 - Show details about a feed:
   ```bash
-  imm show http://your.feed.org
+  imm show 10  # 10 is the index of a subscribed feed, as shown with `imm list`
   ```
 
 - Unsubscribe from a feed:
   ```bash
-  imm unsubscribe http://your.feed.org
+  imm unsubscribe 10  # 10 is the index of a subscribed feed, as shown with `imm list`
   ```
 
 - Check for new elements without executing any action:
@@ -129,4 +123,3 @@
 [1]: http://hackage.haskell.org/package/imm
 [2]: https://www.haskell.org
 [3]: https://dhall-lang.org/
-[4]: https://avro.apache.org/
diff --git a/default.nix b/default.nix
--- a/default.nix
+++ b/default.nix
@@ -6,30 +6,25 @@
   source = nixpkgs.nix-gitignore.gitignoreSource [ ] ./.;
   packageWithoutRuntimeDependencies =
     myHaskellPackages.callCabal2nix "imm" source { };
-  packageWithRuntimeDependencies =
+  packageWithRuntimeDependencies = with nixpkgs;
     addRuntimeDependencies packageWithoutRuntimeDependencies [
-      nixpkgs.httpie
-      nixpkgs.pup
+      pup
+      sqliteInteractive
     ];
 
   exe = hlib.justStaticExecutables packageWithRuntimeDependencies;
 
-  my-avro = {
-    pkg = "avro";
-    ver = "0.5.2.0";
-    sha256 = "0inznspd7lwrc4z7bz12zrdh75zmyibidyb5yblxd3vmni68dx5c";
-  };
-
   my-atom-conduit = {
     pkg = "atom-conduit";
-    ver = "0.8.0.0";
-    sha256 = "17p8180dz3kv9ljfhjqspxp6km50xdcgsdnkknz9w3nfbkpk0l25";
+    ver = "0.9.0.0";
+    sha256 = "11x41fxj0g93kg46z06i1kxfms84wqbad41i7fnm7ixpw4n464pp";
   };
 
-  my-opml-conduit = {
-    pkg = "opml-conduit";
-    ver = "0.8.0.0";
-    sha256 = "14106j2rr6fk6hjhypm5hp1dk1rlxf7svswbj21ad3l40nx7qm7r";
+  my-beam = nixpkgs.fetchFromGitHub {
+    owner = "haskell-beam";
+    repo = "beam";
+    rev = "3bde0615b6eccfe5ca44ed907b79a3cd74eee33f";
+    sha256 = "0fy8p70pxhrllr2njwxa8lijf35hlds2zkhh7fkkv5b3i34jqx29";
   };
 
   my-rss-conduit = {
@@ -45,9 +40,10 @@
           hlib.dontCheck (hlib.dontHaddock (hsuper.callHackageDirect x { }));
       in {
         imm = packageWithRuntimeDependencies;
-        avro = fromHackage my-avro;
         atom-conduit = fromHackage my-atom-conduit;
-        opml-conduit = fromHackage my-opml-conduit;
+        beam-core = hself.callCabal2nix "beam-core" "${my-beam}/beam-core" {};
+        beam-migrate = hself.callCabal2nix "beam-core" "${my-beam}/beam-migrate" {};
+        beam-sqlite = hself.callCabal2nix "beam-core" "${my-beam}/beam-sqlite" {};
         rss-conduit = fromHackage my-rss-conduit;
       };
   };
@@ -67,11 +63,12 @@
   shell = myHaskellPackages.shellFor {
     packages = p: [ p.imm ];
 
-    buildInputs = with nixpkgs.haskellPackages; [
-      cabal-install
-      haskell-ci
-      hlint
-      ghcid
+    buildInputs = with nixpkgs; [
+      haskellPackages.cabal-install
+      haskellPackages.haskell-ci
+      haskellPackages.hlint
+      haskellPackages.ghcid
+      sqliteInteractive
     ];
 
     withHoogle = false;
diff --git a/idl/callback.json b/idl/callback.json
deleted file mode 100644
--- a/idl/callback.json
+++ /dev/null
@@ -1,14 +0,0 @@
-{
-  "type": "record",
-  "name": "message",
-  "fields": [
-    {
-      "name": "feed",
-      "type": "string"
-    },
-    {
-      "name": "element",
-      "type": "string"
-    }
-  ]
-}
diff --git a/imm.cabal b/imm.cabal
--- a/imm.cabal
+++ b/imm.cabal
@@ -1,7 +1,7 @@
 cabal-version:       2.2
 name:                imm
-version:             1.10.0.0
-synopsis:            Execute arbitrary callbacks for each element of RSS/Atom feeds
+version:             2.0.0.0
+synopsis:            Execute arbitrary actions for each item from RSS/Atom feeds
 description:         Cf README file
 homepage:            https://github.com/k0ral/imm
 license:             CC0-1.0
@@ -11,8 +11,8 @@
 category:            Web
 build-type:          Simple
 data-files:          data/*.dhall
-extra-source-files:  README.md, *.nix, idl/*.json
-tested-with:         GHC <8.10 && >=8.4.2
+extra-source-files:  README.md, *.nix, schema/*.json
+tested-with:         GHC <8.12 && >=8.4.4
 
 source-repository head
   type:     git
@@ -29,34 +29,35 @@
   exposed-modules:
     Imm
     Imm.Callback
-    Imm.Database.Feed
     Imm.Feed
     Imm.HTTP
+    Imm.Link
     Imm.Logger
     Imm.Pretty
     Imm.XML
+    URI.ByteString.Extended
   other-modules:
     Data.Aeson.Extended
   build-depends:
     aeson,
-    async,
-    avro,
+    aeson-pretty,
     atom-conduit >= 0.7,
-    binary,
     conduit,
     containers,
     dhall >= 1.27,
     directory >= 1.2.3.0,
     filepath,
-    hashable,
+    http-client,
     microlens,
-    monad-time,
+    parsec,
+    parsers,
     pipes,
     pipes-bytestring,
     prettyprinter,
     prettyprinter-ansi-terminal,
     refined >=0.4.1,
     rss-conduit >= 0.5.1,
+    safe,
     safe-exceptions,
     text,
     time,
@@ -70,23 +71,36 @@
 
 executable imm
   import: common
-  build-depends: imm, aeson, async, atom-conduit >=0.7, avro >=0.5, bytestring, conduit, containers, dhall >= 1.27, directory, fast-logger, filepath, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, pipes, pipes-bytestring, refined >=0.4.1, rss-conduit >=0.4.1, safe, safe-exceptions, stm, stm-chans, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types
+  build-depends: imm, aeson, async, beam-core, beam-sqlite, bytestring, chronos, co-log, conduit, containers, dhall >= 1.27, directory, filepath, http-types, microlens, monad-time, optparse-applicative, prettyprinter-ansi-terminal, pipes, pipes-bytestring, pipes-http, safe, safe-exceptions, sqlite-simple, stm, stm-chans, streamly, text, time, typed-process, typerep-map, uri-bytestring, xml-conduit >=1.5, xml-types
   main-is: Main.hs
-  other-modules: Alternate, Core, Database, HTTP, Logger, Options, Paths_imm, XML
+  other-modules: 
+    Alternate
+    Core
+    Database.Async
+    Database.Handle
+    Database.ReadOnly
+    Database.Record
+    Database.SQLite
+    HTTP
+    Input
+    Logger
+    Output
+    Paths_imm
+    XML
   autogen-modules: Paths_imm
   hs-source-dirs: src/main
   ghc-options: -Wall -fno-warn-unused-do-bind -threaded
 
 executable imm-writefile
   import: common
-  build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, optparse-applicative, prettyprinter, rss-conduit, text, time, uri-bytestring
+  build-depends: imm, aeson, blaze-html, blaze-markup, bytestring, directory, filepath, optparse-applicative, prettyprinter, safe-exceptions, text, time, uri-bytestring
   main-is: Main.hs
   hs-source-dirs: src/write-file
   ghc-options: -Wall -fno-warn-unused-do-bind -threaded
 
 executable imm-sendmail
   import: common
-  build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, dhall >= 1.27, directory, filepath, mime-mail, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, typed-process, uri-bytestring
+  build-depends: imm, aeson, blaze-html, blaze-markup, bytestring, dhall >= 1.27, directory, filepath, mime-mail, optparse-applicative, prettyprinter, refined, safe-exceptions, text, time, typed-process, uri-bytestring
   main-is: Main.hs
   hs-source-dirs: src/send-mail
   ghc-options: -Wall -fno-warn-unused-do-bind -threaded
diff --git a/schema/imm.json b/schema/imm.json
new file mode 100644
--- /dev/null
+++ b/schema/imm.json
@@ -0,0 +1,115 @@
+{
+  "$schema": "http://json-schema.org/draft-07/schema#",
+  "definitions": {
+    "CallbackMessage": {
+      "type": "object",
+      "properties": {
+        "feed_definition": {
+          "$ref": "#/definitions/FeedDefinition"
+        },
+        "feed_item": {
+          "$ref": "#/definitions/ItemDefinition"
+        }
+      }
+    },
+    "FeedDefinition": {
+      "type": "object",
+      "properties": {
+        "title": {
+          "type": "string"
+        }
+      }
+    },
+    "ItemDefinition": {
+      "type": "object",
+      "properties": {
+        "date": {
+          "type": "string",
+          "format": "datetime"
+        },
+        "title": {
+          "type": "string"
+        },
+        "content": {
+          "type": "string"
+        },
+        "links": {
+          "type": "array",
+          "items": {
+            "$ref": "#/definitions/Link"
+          }
+        },
+        "authors": {
+          "type": "array",
+          "items": {
+            "$ref": "#/definitions/Author"
+          }
+        },
+        "identifier": {
+          "type": "string"
+        }
+      }
+    },
+    "Link": {
+      "type": "object",
+      "properies": {
+        "relation": {
+          "$ref": "#/definitions/Relation"
+        },
+        "title": {
+          "type": "string"
+        },
+        "type": {
+          "$ref": "#/definitions/MediaType"
+        },
+        "uri": {
+          "type": "string",
+          "format": "uri"
+        }
+      }
+    },
+    "Relation": {
+      "type": "object",
+      "properties": {
+        "tag": {
+          "type": "string"
+        }
+      }
+    },
+    "MediaType": {
+      "type": "object",
+      "properties": {
+        "type": {
+          "type": "string"
+        },
+        "subtype": {
+          "type": "string"
+        },
+        "suffix": {
+          "type": "string"
+        },
+        "parameters": {
+          "type": "array",
+          "items": {
+            "type": "string"
+          }
+        }
+      }
+    },
+    "Author": {
+      "type": "object",
+      "properies": {
+        "name": {
+          "type": "string"
+        },
+        "email": {
+          "type": "string"
+        },
+        "uri": {
+          "type": "string",
+          "format": "uri"
+        }
+      }
+    }
+  }
+}
diff --git a/src/lib/Imm.hs b/src/lib/Imm.hs
--- a/src/lib/Imm.hs
+++ b/src/lib/Imm.hs
@@ -1,9 +1,8 @@
 -- | Meta-module that reexports many Imm sub-modules.
 module Imm (module X) where
 
-import           Imm.Callback      as X
-import           Imm.Database.Feed as X hiding (Handle)
-import           Imm.Feed          as X
-import           Imm.HTTP          as X hiding (Handle)
-import           Imm.Logger        as X hiding (Handle)
-import           Imm.XML           as X hiding (Handle)
+import           Imm.Callback as X
+import           Imm.Feed     as X
+import           Imm.HTTP     as X hiding (Handle)
+import           Imm.Logger   as X hiding (Handle)
+import           Imm.XML      as X hiding (Handle)
diff --git a/src/lib/Imm/Callback.hs b/src/lib/Imm/Callback.hs
--- a/src/lib/Imm/Callback.hs
+++ b/src/lib/Imm/Callback.hs
@@ -1,21 +1,24 @@
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeApplications  #-}
-module Imm.Callback (Callback(..), serializeMessage, deserializeMessage) where
+module Imm.Callback (Callback(..), CallbackMessage(..), runCallback) where
 
 -- {{{ Imports
-import           Imm.Feed
-
-import qualified Data.Avro                 as Avro
-import           Data.Avro.Deriving
+import           Data.Aeson
+import           Data.Aeson.Encode.Pretty
 import           Data.Text.Prettyprint.Doc
 import           Dhall                     hiding (maybe)
+import           Imm.Feed
+import           Imm.Logger                as Logger
+import           Imm.Pretty
+import           System.Exit
+import           System.Process.Typed
 -- }}}
 
 -- | External program run for each feed element.
 --
--- Data is passed to that program through standard input (@stdin@), using Avro (<https://hackage.haskell.org/package/avro>) serialization format. The data schema is described in file @ids/callback.json@, provided with this library.
+-- Data is passed to that program through standard input (@stdin@).
 data Callback = Callback
   { _executable :: FilePath
   , _arguments  :: [Text]
@@ -26,17 +29,41 @@
 instance Pretty Callback where
   pretty (Callback executable arguments) = pretty executable <+> sep (pretty <$> arguments)
 
+-- | Data structure passed to the external program, through JSON format.
+--
+-- The data schema is described in file @schema/imm.json@, provided with this library.
+data CallbackMessage = CallbackMessage
+  { _callbackFeedDefinition :: FeedDefinition
+  , _callbackFeedItem       :: FeedItem
+  } deriving(Eq, Generic, Ord, Show, Typeable)
 
-deriveAvroWithOptions defaultDeriveOptions "idl/callback.json"
+customOptions :: Options
+customOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_callback")
+  , omitNothingFields = True
+  }
 
--- | Meant to be called by the main @imm@ process.
-serializeMessage :: Feed -> FeedElement -> LByteString
-serializeMessage feed element = Avro.encodeValue $ Message (renderFeed feed) (renderFeedElement element)
+instance ToJSON CallbackMessage where
+  toJSON     = genericToJSON customOptions
+  toEncoding = genericToEncoding customOptions
 
--- | Meant to be called by callback process.
-deserializeMessage :: MonadFail m => LByteString -> m (Feed, FeedElement)
-deserializeMessage bytestring = do
-  Message feedText elementText <- Avro.decodeValue bytestring & either fail pure
-  feed <- parseFeed feedText & either (fail . displayException) pure
-  element <- parseFeedElement elementText & either (fail . displayException) pure
-  return (feed, element)
+instance FromJSON CallbackMessage where
+  parseJSON = genericParseJSON customOptions
+
+instance Pretty (PrettyShort CallbackMessage) where
+  pretty (PrettyShort (CallbackMessage feed item)) = prettyName feed <+> "/" <+> pretty (_itemTitle item)
+
+
+runCallback :: MonadIO m
+  => Logger.Handle m -> Callback -> CallbackMessage -> m (Either (Callback, Int, LByteString, LByteString) (Callback, LByteString, LByteString))
+runCallback logger callback@(Callback executable arguments) message = do
+  log logger Info $ "Running" <+> cyan (pretty executable) <+> "on" <+> prettyShort message
+  log logger Debug $ "Callback message:" <+> pretty (decodeUtf8 @Text $ encodePretty message)
+
+  let processInput = byteStringInput $ encode message
+      processConfig = proc executable (toString <$> arguments) & setStdin processInput
+  (exitCode, output, errors) <- readProcess processConfig
+
+  case exitCode of
+    ExitSuccess   -> return $ Right (callback, output, errors)
+    ExitFailure i -> return $ Left (callback, i, output, errors)
diff --git a/src/lib/Imm/Database/Feed.hs b/src/lib/Imm/Database/Feed.hs
deleted file mode 100644
--- a/src/lib/Imm/Database/Feed.hs
+++ /dev/null
@@ -1,307 +0,0 @@
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE TypeFamilies      #-}
--- | Feed table definitions.
-module Imm.Database.Feed where
-
--- {{{ Imports
-import           Imm.Feed
-import           Imm.Logger             (log, LogLevel(..))
-import qualified           Imm.Logger             as Logger
-import           Imm.Pretty
-
-import           Control.Exception.Safe hiding(handle)
-import           Control.Monad.Time
-import           Data.Aeson.Extended
-import           Data.Hashable
-import           Data.Map          (mapKeys)
-import qualified Data.Map          as Map
-import qualified Data.Set               as Set (intersection)
-import           Data.Time
-
--- To be removed soon
-import           Text.Atom.Types
-import           Text.RSS.Types
--- }}}
-
--- * Types
-
--- DEPRECATED
-getHashes :: FeedElement -> [Int]
-getHashes (RssElement item) = map (hash @String . show . prettyGuid) (maybeToList $ itemGuid item)
-  <> map (hash @String . show . withRssURI prettyURI) (maybeToList $ itemLink item)
-  <> [hash $ itemTitle item]
-  <> [hash $ itemDescription item]
-getHashes (AtomElement entry) = [hash $ entryId entry, (hash :: String -> Int) $ show $ prettyAtomText $ entryTitle entry]
-
-
--- | Newtype wrapper to provide `FromJSON` and `ToJSON` instances for 'FeedElement'
-newtype JsonElement = JsonElement { unwrapElement :: FeedElement } deriving(Eq, Ord)
-
-instance FromJSON JsonElement where
-  parseJSON = withText "Feed element" $ \t -> parseFeedElement t & liftEither <&> JsonElement
-    where liftEither :: Either e a -> Parser a
-          liftEither = either (const mempty) return
-
-instance FromJSONKey JsonElement
-
-instance ToJSON JsonElement where
-  toJSON (JsonElement element) = String $ renderFeedElement element
-
-instance ToJSONKey JsonElement
-
-
-data Entry = Entry
-  { entryLocation    :: FeedLocation
-  , entryTags        :: Set Text
-  , entryReadHashes  :: Set Int
-  , entryFeed        :: Maybe Feed
-  , entryItems       :: Map FeedElement Bool
-  , entryLastUpdate  :: Maybe UTCTime
-  }
-  deriving(Eq, Ord, Show)
-
-prettyShortEntry :: Entry -> Doc AnsiStyle
-prettyShortEntry Entry{..} = magenta feedID
-  <++> indent 3 tags
-  <++> indent 3 ("Last update:" <+> lastUpdate)
-  <++> indent 3 (yellow (pretty totalItems) <+> "items," <+> yellow (pretty totalUnprocessedItems) <+> "unprocessed")
-
-  where feedID = pretty entryLocation
-        tags = sep $ map ((<>) "#" . pretty) $ toList entryTags
-        lastUpdate = maybe "never" prettyTime entryLastUpdate
-        totalItems = length entryItems
-        totalUnprocessedItems = length $ Map.filter not entryItems
-
-prettyEntry :: Entry -> Doc AnsiStyle
-prettyEntry Entry{..} = magenta (pretty entryLocation)
-  <++> tags
-  <++> ("Last update:" <+> lastUpdate)
-  <++> (yellow (pretty $ length $ Map.filter id entryItems) <+> "processed items")
-  <++> indent 3 (vsep $ map displayItem $ Map.keys $ Map.filter id entryItems)
-  <++> (yellow (pretty $ length $ Map.filter not entryItems) <+> "unprocessed items")
-  <++> indent 3 (vsep $ map displayItem $ Map.keys $ Map.filter not entryItems)
-  where tags = sep $ map ((<>) "#" . pretty) $ toList entryTags
-        lastUpdate = maybe "never" prettyTime entryLastUpdate
-        displayItem item = maybe "<unknown>" prettyTime (getDate item) <+> pretty (getTitle item)
-
-instance FromJSON Entry where
-  parseJSON (Object v) = Entry
-    <$> ((parseJSON =<< v .: "uri") <|> (parseJSON =<< v .: "location"))
-    <*> v .: "tags"
-    <*> (v .: "readHashes" <|> pure mempty)
-    <*> ((v .:? "feed") >>= maybe (pure Nothing) (fmap Just . liftEither . parseFeed))
-    <*> (v .:? "items" >>= maybe (pure mempty) (return . mapKeys unwrapElement))
-    <*> (v .: "lastUpdate" <|> v .: "lastCheck")
-    where liftEither :: Either e a -> Parser a
-          liftEither = either (const mempty) return
-
-  parseJSON _          = mzero
-
-instance ToJSON Entry where
-  toJSON Entry{..} = object $
-    [ "location"   .= toJSON entryLocation
-    , "tags"       .= entryTags
-    , "items"      .= mapKeys JsonElement entryItems
-    , "lastUpdate"  .= entryLastUpdate
-    ] <> maybeToList (fmap (("feed" .=) . renderFeed) entryFeed)
-      <> if null entryReadHashes then mempty else ["readHashes" .= entryReadHashes]
-
-makeEntry :: FeedLocation -> Set Text -> Entry
-makeEntry feedLocation tags = Entry feedLocation tags mempty mzero mempty Nothing
-
-matching :: FeedQuery -> Int -> Entry -> Bool
-matching AllFeeds _ _ = True
-matching (ByURI uri) _ entry = case entryLocation entry of
-  FeedDirectURI uri' -> uri == uri'
-  FeedAlternateLink uri' _ -> uri == uri'
-matching (ByDatabaseID i) j _ = i == j
-
-
-data FeedStatus = Unknown | New | LastUpdate UTCTime
-
-instance Pretty FeedStatus where
-  pretty Unknown        = "Unknown"
-  pretty New            = "New"
-  pretty (LastUpdate x) = "Last update:" <+> pretty (formatTime defaultTimeLocale rfc822DateFormat x)
-
-
-
-data EntryKey = ByLocation FeedLocation | ById Int
-  deriving(Eq, Ord, Show)
-
-instance Pretty EntryKey where
-  pretty (ByLocation location) = pretty location
-  pretty (ById i) = "ID" <+> pretty i
-
-
-data Handle m = Handle
-  { _describeDatabase :: m (Doc AnsiStyle)
-  , _fetch  :: [EntryKey] -> m (Map EntryKey (Int, Entry))
-  , _fetchAll         :: m (Map Int Entry)
-  , _update :: [EntryKey] -> (Entry -> Entry) -> m ()
-  , _insert           :: [Entry ] -> m (Map FeedLocation Int)
-  , _delete      :: [EntryKey] -> m ()
-  , _purge            :: m ()
-  , _commit           :: m ()
-  }
-
-readOnly :: Monad m => Logger.Handle m -> Handle m -> Handle m
-readOnly logger handle = handle
-  { _describeDatabase = do
-      output <- _describeDatabase handle
-      return $ output <+> yellow (brackets "read only")
-  , _update = \keys _ -> log logger Debug $ "Not updating database for keys" <+> pretty keys
-  , _insert = \entries -> log logger Debug ("Not inserting " <> yellow (pretty $ length entries) <> " entries") $> mempty
-  , _delete = \keys -> log logger Debug $ "Not deleting " <> yellow (pretty $ length keys) <> " entries"
-  , _purge = log logger Debug "Not purging database"
-  , _commit = log logger Debug "Not committing database"
-  }
-
-
-
-data DatabaseException
-  = NotCommitted
-  | NotDeleted [FeedLocation]
-  | KeyNotFound [EntryKey]
-  | NotInserted [Entry]
-  | NotPurged
-  | NotUpdated FeedLocation
-  | UnableFetchAll
-  deriving(Eq, Show)
-
-instance Exception DatabaseException where
-  displayException = show . pretty
-
-instance Pretty DatabaseException where
-  pretty NotCommitted = "Unable to commit database changes."
-  pretty (NotDeleted x) = "Unable to delete the following entries in database:" <++> indent 2 (vsep $ map pretty x)
-  pretty (KeyNotFound x) = "Unable to find the following entries in database:" <++> indent 2 (vsep $ map pretty x)
-  pretty (NotInserted x) = "Unable to insert the following entries in database:" <++> indent 2 (vsep $ map (pretty . entryLocation) x)
-  pretty NotPurged = "Unable to purge feed database"
-  pretty (NotUpdated x) = "Unable to update the following entry in database:" <++> indent 2 (pretty x)
-  pretty UnableFetchAll = "Unable to fetch all entries from database."
-
-
--- * Low-level primitives
-
-fetch1 :: Monad m => MonadThrow m => Handle m -> EntryKey -> m (Int, Entry)
-fetch1 handle k = do
-  results <- _fetch handle [k]
-  maybe (throwM $ KeyNotFound [k]) return $ lookup k results
-
-
-fetch :: Monad m => Handle m -> [EntryKey] -> m (Map EntryKey (Int, Entry))
-fetch = _fetch
-
-fetchQuery :: Monad m => Handle m -> (Int -> Entry -> Bool) -> m (Map Int Entry)
-fetchQuery handle f = _fetchAll handle
-  <&> Map.filterWithKey f
-
-fetchAll :: Monad m => Handle m -> m (Map Int Entry)
-fetchAll = _fetchAll
-
-update :: Monad m => Handle m -> [EntryKey] -> (Entry -> Entry) -> m ()
-update = _update
-
-insert :: MonadThrow m => Logger.Handle m -> Handle m -> Entry -> m Int
-insert logger handle entry = insertList logger handle [entry]
-  <&> Map.lookup (entryLocation entry)
-  >>= maybe (throwM $ NotInserted [entry]) pure
-
-insertList :: Monad m => Logger.Handle m -> Handle m -> [Entry] -> m (Map FeedLocation Int)
-insertList logger handle i = do
-  log logger Info $ "Inserting " <> yellow (pretty $ length i) <> " entries..."
-  _insert handle i
-
-delete1 :: Monad m => Logger.Handle m -> Handle m -> EntryKey -> m ()
-delete1 logger handle k = delete logger handle [k]
-
-delete :: Monad m => Logger.Handle m -> Handle m -> [EntryKey] -> m ()
-delete logger handle k = do
-  log logger Info $ "Deleting " <> yellow (pretty $ length k) <> " entries..."
-  _delete handle k
-
-purge :: Monad m => Logger.Handle m -> Handle m -> m ()
-purge logger handle = do
-  log logger Info "Purging database..."
-  _purge handle
-
-commit :: Monad m => Logger.Handle m -> Handle m -> m ()
-commit logger handle = do
-  log logger Debug "Committing database transaction..."
-  _commit handle
-  log logger Debug "Database transaction committed"
-
-
--- * High-level queries
-
-register :: MonadThrow m => Logger.Handle m -> Handle m -> FeedLocation -> Set Text -> m Int
-register logger database feedLocation tags = do
-  log logger Info $ "Registering feed" <+> magenta (pretty feedLocation) <> "..."
-  insert logger database $ makeEntry feedLocation tags
-
-getStatus :: MonadCatch m => Handle m -> EntryKey -> m FeedStatus
-getStatus database key = handleAny (\_ -> return Unknown) $ do
-  result <- fmap Just (fetch1 database key) `catchAny` (\_ -> return Nothing)
-  return $ maybe New LastUpdate $ entryLastUpdate . snd =<< result
-
-markAsProcessed :: MonadThrow m => MonadTime m
-                => Logger.Handle m -> Handle m -> EntryKey -> FeedElement -> m ()
-markAsProcessed logger database key element = do
-  log logger Debug $ "Marking as processed:" <+> pretty (PrettyKey element) <> "..."
-  utcTime <- currentTime
-  update database [key] $ \entry -> entry
-    { entryItems = Map.insert element True $ entryItems entry
-    , entryLastUpdate = Just utcTime
-    }
-
-
-markAsUnprocessed :: MonadThrow m => Logger.Handle m -> Handle m -> EntryKey -> m ()
-markAsUnprocessed logger database key = do
-  log logger Debug $ "Marking as unprocessed:" <+> pretty key <> "..."
-  update database [key] $ \entry -> entry
-    { entryItems = False <$ entryItems entry
-    , entryLastUpdate = Nothing
-    , entryReadHashes = mempty
-    }
-
-listUnprocessedElements :: MonadThrow m => Handle m -> EntryKey -> m [FeedElement]
-listUnprocessedElements database key = fetch1 database key
-  <&> snd
-  <&> entryItems
-  <&> Map.filterWithKey (\_ v -> not v)
-  <&> Map.keys
-
-isRead :: MonadCatch m => Handle m -> EntryKey -> FeedElement -> m Bool
-isRead database key element = do
-  (_, entry) <- fetch1 database key
-  let matchHash = not $ null $ fromList (getHashes element) `Set.intersection` entryReadHashes entry
-      matchDate = case (entryLastUpdate entry, getDate element) of
-        (Nothing, _)     -> False
-        (_, Nothing)     -> False
-        (Just a, Just b) -> a > b
-      matchKey = Map.findWithDefault False element $ entryItems entry
-  return $ matchHash || matchDate || matchKey
-
-resolveEntryKey :: Monad m => Handle m -> FeedQuery -> m [EntryKey]
-resolveEntryKey _ (ByDatabaseID i) = pure [ById i]
-resolveEntryKey database (ByURI uri) = fetchAll database
-  <&> Map.filter f
-  <&> toList
-  <&> map (ByLocation . entryLocation)
-  where f entry = case entryLocation entry of
-          FeedDirectURI uri' -> uri == uri'
-          FeedAlternateLink uri' _ -> uri == uri'
-resolveEntryKey database AllFeeds = fetchAll database
-  <&> toList
-  <&> map (ByLocation . entryLocation)
-
-resolveFeedLocation :: Monad m => Handle m -> EntryKey -> m FeedLocation
-resolveFeedLocation database (ById i) = fetchAll database
-  <&> Map.elemAt i
-  <&> snd
-  <&> entryLocation
-resolveFeedLocation _ (ByLocation location) = return location
diff --git a/src/lib/Imm/Feed.hs b/src/lib/Imm/Feed.hs
--- a/src/lib/Imm/Feed.hs
+++ b/src/lib/Imm/Feed.hs
@@ -1,181 +1,227 @@
-{-# LANGUAGE DataKinds                 #-}
-{-# LANGUAGE FlexibleInstances         #-}
-{-# LANGUAGE GADTs                     #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE RankNTypes                #-}
-{-# LANGUAGE StandaloneDeriving        #-}
-{-# LANGUAGE TypeOperators             #-}
--- | Helpers to manipulate feeds
-module Imm.Feed where
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+-- | Feed data structures.
+module Imm.Feed
+  ( -- * Types
+    FeedLocation(..)
+  , UID
+  , FeedQuery(..)
+  , FeedDefinition(..)
+  , FeedItem(..)
+  , Author(..)
+  , -- * Parsers
+    parseFeed
+  , feedC
+  , parseFeedItem
+  , -- * Utilities
+    getMainLink
+  , areSameItem
+  ) where
 
 -- {{{ Imports
-import           Imm.Pretty
-
 import           Conduit
 import           Control.Exception.Safe
 import           Data.Aeson.Extended
-import           Data.Binary.Builder
 import           Data.Text                      as Text (null)
 import           Data.Time
-import           Data.Type.Equality
+import           Data.XML.Types
+import           Imm.Link
+import           Imm.Pretty
+import           Refined
+import           Safe
 import           Text.Atom.Conduit.Parse
-import           Text.Atom.Conduit.Render
 import           Text.Atom.Types
 import           Text.RSS.Conduit.Parse
-import           Text.RSS.Conduit.Render
 import           Text.RSS.Extensions.Content
 import           Text.RSS.Extensions.DublinCore
 import           Text.RSS.Types
 import           Text.RSS1.Conduit.Parse
 import           Text.XML.Stream.Parse          as XML hiding (content)
-import           Text.XML.Stream.Render         hiding (content)
-import           URI.ByteString
+import           URI.ByteString.Extended
 -- }}}
 
--- * Types
-
 -- | Feed location identifies a feed. It is either:
 -- - the feed URI
 -- - a webpage URI that refers to the feed through an alternate link, in which case an optional feed title can be provided to disambiguate multiple such links
-data FeedLocation = FeedDirectURI URI | FeedAlternateLink URI Text
-  deriving(Eq, Ord, Show)
+data FeedLocation = FeedLocation URI Text
+  deriving(Eq, Generic, Ord, Show, Typeable)
 
 instance Pretty FeedLocation where
-  pretty (FeedDirectURI uri) = prettyURI uri
-  pretty (FeedAlternateLink uri title) = prettyURI uri
+  pretty (FeedLocation uri title) = prettyURI uri
     <> if Text.null title then mempty else space <> brackets (pretty title)
 
+instance ToJSON FeedLocation where
+  toJSON (FeedLocation uri title) = object
+    [ "uri" .= toJSON (JsonURI uri)
+    , "title" .= title
+    ]
+
 instance FromJSON FeedLocation where
-  parseJSON value = oldStyleDirectURI <|> newStyleDirectURI value <|> alternateLink value where
-    oldStyleDirectURI = FeedDirectURI . _unwrapURI <$> parseJSON value
-    newStyleDirectURI = withObject "Feed direct URI" $ \v -> FeedDirectURI . _unwrapURI
-      <$> v .: "direct"
-    alternateLink = withObject "Feed alternate link" $ \v -> FeedAlternateLink
-      <$> (v .: "alternate" <&> _unwrapURI)
-      <*> (v .: "title" <|> pure mempty)
+  parseJSON = withObject "FeedLocation" $ \v -> do
+    FeedLocation <$> (_unwrapURI <$> (v .: "uri")) <*> (v .: "title")
 
-instance ToJSON FeedLocation where
-  toJSON (FeedDirectURI uri) = object [ "direct" .= toJSON (JsonURI uri) ]
-  toJSON (FeedAlternateLink uri title) = object $ [ "alternate" .= toJSON (JsonURI uri) ] <> [ "title" .= toJSON title | not (Text.null title)]
 
+-- | Database identifier for a feed
+type UID = Int
 
 -- | A query describes a set of feeds through some criteria.
-data FeedQuery = ByDatabaseID Int | ByURI URI | AllFeeds
-  deriving(Eq, Ord, Show)
+data FeedQuery = QueryByUID UID | QueryAll
+  deriving(Eq, Ord, Read, Show, Typeable)
 
 instance Pretty FeedQuery where
-  pretty AllFeeds = "All subscribed feeds"
-  pretty (ByURI u) = prettyURI u
-  pretty (ByDatabaseID n) = "database feed" <+> pretty n
+  pretty QueryAll       = "All subscribed feeds"
+  pretty (QueryByUID k) = "Feed" <+> pretty k
 
 
-data Feed = Rss (RssDocument (ContentModule (DublinCoreModule NoExtensions))) | Atom AtomFeed
-  deriving(Eq, Ord, Show)
+newtype FeedDefinition = FeedDefinition
+  { _feedTitle :: Text
+  } deriving(Eq, Generic, Ord, Read, Show, Typeable)
 
-data FeedElement = RssElement (RssItem (ContentModule (DublinCoreModule NoExtensions))) | AtomElement AtomEntry
-  deriving(Show)
+feedDefinitionOptions :: Options
+feedDefinitionOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_feed")
+  , omitNothingFields = True
+  }
 
-instance Pretty (PrettyKey FeedElement) where
-  pretty (PrettyKey element) = "element" <+> pretty (getTitle element)
+instance ToJSON FeedDefinition where
+  toJSON     = genericToJSON feedDefinitionOptions
+  toEncoding = genericToEncoding feedDefinitionOptions
 
-instance Ord FeedElement where
-  compare element1 element2 = compare (getId element1) (getId element2)
-    <> compare (getLink element1) (getLink element2)
-    <> compare (getTitle element1) (getTitle element2)
-    <> compare (getContent element1) (getContent element2)
+instance FromJSON FeedDefinition where
+  parseJSON = genericParseJSON feedDefinitionOptions
 
-instance Eq FeedElement where
-  element1 == element2 = compare element1 element2 == EQ
+instance Pretty FeedDefinition where
+  pretty definition = pretty $ _feedTitle definition
 
+instance Pretty (PrettyName FeedDefinition) where
+  pretty (PrettyName definition) = pretty $ _feedTitle definition
 
-data FeedURI = forall a . FeedURI (URIRef a)
 
-deriving instance Show FeedURI
-instance Eq FeedURI where
-  (FeedURI a) == (FeedURI b) = case sameURIType a b of
-    Just Refl -> a == b
-    _         -> False
+data Author = Author
+  { _authorName  :: Text
+  , _authorEmail :: Text
+  , _authorURI   :: Maybe AnyURI
+  } deriving(Eq, Generic, Ord, Show, Typeable)
 
-instance Ord FeedURI where
-  compare (FeedURI a) (FeedURI b) = case (a, b) of
-    (URI{}, URI{})                 -> compare a b
-    (RelativeRef{}, RelativeRef{}) -> compare a b
-    (URI{}, RelativeRef{})         -> LT
-    (RelativeRef{}, URI{})         -> GT
+authorOptions :: Options
+authorOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_author")
+  , omitNothingFields = True
+  }
 
-sameURIType :: URIRef a1 -> URIRef a2 -> Maybe (URIRef a1 :~: URIRef a2)
-sameURIType a b = case (a, b) of
-  (URI{}, URI{})                 -> Just Refl
-  (RelativeRef{}, RelativeRef{}) -> Just Refl
-  _                              -> Nothing
+instance ToJSON Author where
+  toJSON     = genericToJSON authorOptions
+  toEncoding = genericToEncoding authorOptions
 
+instance FromJSON Author where
+  parseJSON = genericParseJSON authorOptions
 
-withFeedURI :: (forall a . URIRef a -> b) -> FeedURI -> b
-withFeedURI f (FeedURI a) = f a
+instance Pretty Author where
+  pretty Author{..} = pretty _authorName <+> brackets (pretty _authorEmail)
 
 
--- * Generic parsers/renderers
+data FeedItem = FeedItem
+  { _itemDate       :: Maybe UTCTime
+  , _itemTitle      :: Text
+  , _itemContent    :: Text
+  , _itemLinks      :: [Link]
+  , _itemIdentifier :: Text
+  , _itemAuthors    :: [Author]
+  } deriving(Eq, Generic, Ord, Show, Typeable)
 
-renderFeed :: Feed -> Text
-renderFeed (Rss rss) = decodeUtf8 $ toLazyByteString $ runConduitPure $ renderRssDocument rss .| renderBuilder def .| foldC
-renderFeed (Atom atom) = decodeUtf8 $ toLazyByteString $ runConduitPure $ renderAtomFeed atom .| renderBuilder def .| foldC
+feedItemOptions :: Options
+feedItemOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_item")
+  , omitNothingFields = True
+  }
 
-renderFeedElement :: FeedElement -> Text
-renderFeedElement (RssElement item) = decodeUtf8 $ toLazyByteString $ runConduitPure $ renderRssItem item .| renderBuilder def .| foldC
-renderFeedElement (AtomElement entry) = decodeUtf8 $ toLazyByteString $ runConduitPure $ renderAtomEntry entry .| renderBuilder def .| foldC
+instance ToJSON FeedItem where
+  toJSON     = genericToJSON feedItemOptions
+  toEncoding = genericToEncoding feedItemOptions
 
-parseFeed :: MonadCatch m => Text -> m Feed
-parseFeed text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed" (choose [fmap Atom <$> atomFeed, fmap Rss <$> rssDocument, fmap Rss <$> rss1Document])
+instance FromJSON FeedItem where
+  parseJSON = genericParseJSON feedItemOptions
 
-parseFeedElement :: MonadCatch m => Text -> m FeedElement
-parseFeedElement text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed element" (choose [fmap AtomElement <$> atomEntry, fmap RssElement <$> rssItem, fmap RssElement <$> rss1Item])
+instance Pretty (PrettyName FeedItem) where
+  pretty (PrettyName item) = pretty (_itemTitle item)
 
+instance Pretty FeedItem where
+  pretty FeedItem{..} = maybe "<unknown>" prettyTime _itemDate <+> pretty _itemTitle
 
--- * Generic mutators
 
-removeElements :: Feed -> Feed
-removeElements (Rss rss)   = Rss $ rss { channelItems = mempty }
-removeElements (Atom atom) = Atom $ atom { feedEntries = mempty }
+parseFeed :: MonadCatch m => Text -> m (FeedDefinition, [FeedItem])
+parseFeed text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed" feedC
 
+parseAtomFeed :: AtomFeed -> (FeedDefinition, [FeedItem])
+parseAtomFeed feed = (definition, items) where
+  definition = FeedDefinition (show $ prettyAtomText $ feedTitle feed)
+  items = parseAtomItem <$> feedEntries feed
 
--- * Generic getters
+parseRssFeed :: RssDocument (ContentModule (DublinCoreModule NoExtensions)) -> (FeedDefinition, [FeedItem])
+parseRssFeed doc = (definition, items) where
+  definition = FeedDefinition (channelTitle doc)
+  items = parseRssItem <$> channelItems doc
 
-getFeedTitle :: Feed -> Text
-getFeedTitle (Rss doc)   = channelTitle doc
-getFeedTitle (Atom feed) = show $ prettyAtomText $ feedTitle feed
+-- | Conduit version of 'parseFeed'
+feedC :: MonadCatch m => ConduitT Event o m (Maybe (FeedDefinition, [FeedItem]))
+feedC = choose [atom, rss, rss1] where
+  atom = fmap parseAtomFeed <$> atomFeed
+  rss = fmap parseRssFeed <$> rssDocument
+  rss1 = fmap parseRssFeed <$> rss1Document
 
-getElements :: Feed -> [FeedElement]
-getElements (Rss doc)   = map RssElement $ channelItems doc
-getElements (Atom feed) = map AtomElement $ feedEntries feed
+parseFeedItem :: MonadCatch m => Text -> m FeedItem
+parseFeedItem text = runConduit $ parseLBS def (encodeUtf8 text) .| XML.force "Invalid feed element" (choose [fmap parseAtomItem <$> atomEntry, fmap parseRssItem <$> rssItem, fmap parseRssItem <$> rss1Item])
 
-getDate :: FeedElement -> Maybe UTCTime
-getDate (RssElement item)   = itemPubDate item <|> (item & itemExtensions & itemContentOther & itemDcMetaData & elementDate)
-getDate (AtomElement entry) = Just $ entryUpdated entry
+parseAtomItem :: AtomEntry -> FeedItem
+parseAtomItem entry = FeedItem date title content links identifier authors where
+  date = Just $ entryUpdated entry
+  title = show $ prettyAtomText $ entryTitle entry
+  content = fromMaybe "<empty>" $ rawContent <|> summary
+  rawContent = show . prettyAtomContent <$> entryContent entry
+  summary = show . prettyAtomText <$> entrySummary entry
+  links = parseLink <$> entryLinks entry
+  parseLink link = Link (pure $ fromMaybe Alternate $ parseRelation $ linkRel link) (linkTitle link) (parseMediaType $ linkType link) (withAtomURI AnyURI $ linkHref link)
+  identifier = entryId entry
+  authors = [Author (unrefine name) email (withAtomURI AnyURI <$> uri) | AtomPerson name email uri <- entryAuthors entry]
 
-getTitle :: FeedElement -> Text
-getTitle (RssElement item)   = itemTitle item
-getTitle (AtomElement entry) = show $ prettyAtomText $ entryTitle entry
+parseRssItem :: RssItem (ContentModule (DublinCoreModule NoExtensions)) -> FeedItem
+parseRssItem item = FeedItem date title content links identifier authors where
+  date = itemPubDate item <|> (item & itemExtensions & itemContentOther & itemDcMetaData & elementDate)
+  title = itemTitle item
+  content = if not (Text.null rawContent) then rawContent else itemDescription item
+  rawContent = item & itemExtensions & itemContent
+  links = [Link (Just Alternate) mempty mzero (withRssURI AnyURI uri) | uri <- maybeToList $ itemLink item]
+  identifier = itemGuid item <&> prettyGuid & maybe mempty show
+  authors = [Author (itemAuthor item) mempty mzero]
 
-getContent :: FeedElement -> Text
-getContent (RssElement item) = if not (Text.null content) then content else itemDescription item where
-  content = item & itemExtensions & itemContent
-getContent (AtomElement entry) = fromMaybe "<empty>" $ content <|> summary where
-  content = show . prettyAtomContent <$> entryContent entry
-  summary = show . prettyAtomText <$> entrySummary entry
 
-getLink :: FeedElement -> Maybe FeedURI
-getLink (RssElement item) = itemLink item <&> withRssURI FeedURI
-getLink (AtomElement entry) = (alternateLink <|> defaultLink) <&> linkHref <&> withAtomURI FeedURI where
-  links = entryLinks entry
-  alternateLink = links & filter (\link -> linkRel link == "alternate") & nonEmpty <&> head
-  defaultLink = links & filter (Text.null . linkRel) & nonEmpty <&> head
+-- TODO: replace headMay with singleMay
+getMainLink :: FeedItem -> Maybe Link
+getMainLink item = _itemLinks item & filter (\l -> _linkRelation l == Just Alternate) & headMay
 
-getId :: FeedElement -> Text
-getId (RssElement item)   = itemGuid item <&> prettyGuid & maybe mempty show
-getId (AtomElement entry) = entryId entry
+haveSameIdentifier :: FeedItem -> FeedItem -> Maybe Bool
+haveSameIdentifier item1 item2 = case (_itemIdentifier item1, _itemIdentifier item2) of
+  ("", "") -> Nothing
+  (a, b)   -> Just (a == b)
 
--- * Misc
+haveSameLink :: FeedItem -> FeedItem -> Maybe Bool
+haveSameLink item1 item2 = case (getMainLink item1, getMainLink item2) of
+  (Just a, Just b)   -> Just (a == b)
+  (Nothing, Nothing) -> Nothing
+  _                  -> Just False
 
-prettyElement :: FeedElement -> Doc a
-prettyElement (RssElement item)   = prettyItem item
-prettyElement (AtomElement entry) = prettyEntry entry
+haveSameTitle :: FeedItem -> FeedItem -> Maybe Bool
+haveSameTitle item1 item2 = case (_itemTitle item1, _itemTitle item2) of
+  ("" :: Text, "" :: Text) -> Nothing
+  (a, b)                   -> Just (a == b)
+
+areSameItem :: FeedItem -> FeedItem -> Bool
+areSameItem a b = fromMaybe (comparing _itemContent a b == EQ) $ haveSameIdentifier a b <|> haveSameLink a b <|> haveSameTitle a b
diff --git a/src/lib/Imm/HTTP.hs b/src/lib/Imm/HTTP.hs
--- a/src/lib/Imm/HTTP.hs
+++ b/src/lib/Imm/HTTP.hs
@@ -7,13 +7,17 @@
 -- This module follows the [Handle pattern](https://jaspervdj.be/posts/2018-03-08-handle-pattern.html).
 --
 -- > import qualified Imm.HTTP as HTTP
-module Imm.HTTP where
+module Imm.HTTP
+  ( module Imm.HTTP
+  , module Network.HTTP.Client
+  ) where
 
 -- {{{ Imports
-import           Imm.Logger     hiding (Handle)
-import qualified Imm.Logger     as Logger
+import           Imm.Logger          hiding (Handle)
+import qualified Imm.Logger          as Logger
 import           Imm.Pretty
 
+import           Network.HTTP.Client
 import           Pipes.Core
 import           URI.ByteString
 -- }}}
@@ -22,14 +26,14 @@
 
 -- | Handle to perform GET HTTP requests.
 newtype Handle m = Handle
-  { _withGet :: forall a. URI -> (Producer' ByteString m () -> m a) -> m a
+  { _withGet :: forall a. URI -> (Response (Producer ByteString m ()) -> m a) -> m a
   }
 
 
 -- * Primitives
 
 -- | Simple wrapper around '_withGet' that also logs the requested URI.
-withGet :: Monad m => Logger.Handle m -> Handle m -> URI -> (Producer' ByteString m () -> m a) -> m a
+withGet :: Monad m => Logger.Handle m -> Handle m -> URI -> (Response (Producer ByteString m ()) -> m a) -> m a
 withGet logger handle uri f = do
-  log logger Debug $ "GET" <+> prettyURI uri
+  log logger Info $ "GET" <+> prettyURI uri
   _withGet handle uri f
diff --git a/src/lib/Imm/Link.hs b/src/lib/Imm/Link.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Imm/Link.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms   #-}
+{-# LANGUAGE TypeApplications  #-}
+-- | Simplified model for RFC 8288 links.
+--
+-- Cf <https://tools.ietf.org/html/rfc8288> . .
+module Imm.Link
+  ( Link(..)
+  , Relation(..)
+  , parseRelation
+  , MediaType(..)
+  , parseMediaType
+  , pattern MediaTypeRSS
+  , pattern MediaTypeAtom
+  , pattern MediaTypeApplicationXML
+  , pattern MediaTypeTextXML
+  , pattern MediaTypeHTML
+  ) where
+
+import           Data.Aeson
+import           Text.Parsec             (Stream, parse)
+import           Text.Parser.Char
+import           URI.ByteString.Extended
+
+
+data Link = Link
+  { _linkRelation :: Maybe Relation
+  , _linkTitle    :: Text
+  , _linkType     :: Maybe MediaType
+  , _linkURI      :: AnyURI
+  } deriving(Eq, Generic, Ord, Show, Typeable)
+
+linkOptions :: Options
+linkOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_link")
+  , omitNothingFields = True
+  }
+
+instance ToJSON Link where
+  toJSON     = genericToJSON linkOptions
+  toEncoding = genericToEncoding linkOptions
+
+instance FromJSON Link where
+  parseJSON = genericParseJSON linkOptions
+
+
+-- | Cf <https://www.iana.org/assignments/link-relations/link-relations.xhtml> .
+data Relation = Alternate | Edit | Next | NoFollow | Replies | Self | OtherRelation Text
+  deriving (Eq, Generic, Ord, Read, Show, Typeable)
+
+instance ToJSON Relation where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON Relation
+
+parseRelation :: Text -> Maybe Relation
+parseRelation "alternate" = pure Alternate
+parseRelation "edit"      = pure Edit
+parseRelation "next"      = pure Next
+parseRelation "nofollow"  = pure NoFollow
+parseRelation "replies"   = pure Replies
+parseRelation "self"      = pure Self
+parseRelation ""          = Nothing
+parseRelation t           = pure $ OtherRelation t
+
+
+-- | https://tools.ietf.org/html/rfc6838
+-- https://en.wikipedia.org/wiki/Media_type
+data MediaType = MediaType
+  { _mediaType       :: Text
+  , _mediaSubtype    :: Text
+  , _mediaSuffix     :: Text
+  , _mediaParameters :: [Text]
+  } deriving (Eq, Generic, Ord, Read, Show, Typeable)
+
+mediaTypeOptions :: Options
+mediaTypeOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_media")
+  , omitNothingFields = True
+  }
+
+instance ToJSON MediaType where
+  toJSON     = genericToJSON mediaTypeOptions
+  toEncoding = genericToEncoding mediaTypeOptions
+
+instance FromJSON MediaType where
+  parseJSON = genericParseJSON mediaTypeOptions
+
+
+parseMediaType :: Stream s Identity Char => s -> Maybe MediaType
+parseMediaType = either (const Nothing) pure . parse parser "" where
+  parser = do
+    t <- some $ noneOf "/"
+    char '/'
+    subtype <- some $ noneOf "+;"
+    suffix <- optional $ char '+' >> some (noneOf ";")
+    parameters <- many $ char ';' >> some (noneOf ";")
+
+    return $ MediaType (toText t) (toText subtype) (toText $ fromMaybe mempty suffix) $ map toText parameters
+
+
+pattern MediaTypeRSS :: [Text] -> MediaType
+pattern MediaTypeRSS parameters = MediaType "application" "rss" "xml" parameters
+
+pattern MediaTypeAtom :: [Text] -> MediaType
+pattern MediaTypeAtom parameters = MediaType "application" "atom" "xml" parameters
+
+pattern MediaTypeApplicationXML :: Text -> [Text] -> MediaType
+pattern MediaTypeApplicationXML suffix parameters = MediaType "application" "xml" suffix parameters
+
+pattern MediaTypeTextXML :: Text -> [Text] -> MediaType
+pattern MediaTypeTextXML suffix parameters = MediaType "text" "xml" suffix parameters
+
+pattern MediaTypeHTML :: Text -> [Text] -> MediaType
+pattern MediaTypeHTML suffix parameters = MediaType "text" "html" suffix parameters
diff --git a/src/lib/Imm/Logger.hs b/src/lib/Imm/Logger.hs
--- a/src/lib/Imm/Logger.hs
+++ b/src/lib/Imm/Logger.hs
@@ -17,11 +17,9 @@
 -- * Types
 
 data Handle m = Handle
-  { log :: LogLevel -> Doc AnsiStyle -> m ()
+  { log         :: LogLevel -> Doc AnsiStyle -> m ()
   , getLogLevel :: m LogLevel
   , setLogLevel :: LogLevel -> m ()
-  , setColorizeLogs :: Bool -> m ()
-  , flushLogs :: m ()
   }
 
 data LogLevel = Debug | Info | Warning | Error
diff --git a/src/lib/Imm/Pretty.hs b/src/lib/Imm/Pretty.hs
--- a/src/lib/Imm/Pretty.hs
+++ b/src/lib/Imm/Pretty.hs
@@ -6,18 +6,16 @@
 
 -- {{{ Imports
 import qualified Data.Text                                 as Text
-import           Data.Time
-import           Data.Tree
-import           Data.XML.Types                            as XML
-import           Text.Atom.Types                           as Atom
--- import           Text.OPML.Types              as OPML hiding (text)
--- import qualified Text.OPML.Types              as OPML
 import           Data.Text.Prettyprint.Doc                 as X hiding (list, width)
 import           Data.Text.Prettyprint.Doc                 (list)
 import           Data.Text.Prettyprint.Doc.Render.Terminal as X (AnsiStyle)
 import           Data.Text.Prettyprint.Doc.Render.Terminal
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
+import           Data.Time
+import           Data.Tree
+import           Data.XML.Types                            as XML
 import           Refined
+import           Text.Atom.Types                           as Atom
 import           Text.RSS.Types                            as RSS
 import           URI.ByteString
 -- }}}
@@ -26,6 +24,22 @@
 -- | Newtype wrapper to prettyprint a key uniquely identifying an object
 newtype PrettyKey a = PrettyKey a
 
+prettyKey :: Pretty (PrettyKey a) => a -> Doc b
+prettyKey = pretty . PrettyKey
+
+-- | Newtype wrapper to prettyprint a user-friendly name referring to an object
+newtype PrettyName a = PrettyName a
+
+prettyName :: Pretty (PrettyName a) => a -> Doc b
+prettyName = pretty . PrettyName
+
+-- | Newtype wrapper to prettyprint a short description of an object
+newtype PrettyShort a = PrettyShort a
+
+prettyShort :: Pretty (PrettyShort a) => a -> Doc b
+prettyShort = pretty . PrettyShort
+
+
 -- | Infix operator for 'line'
 (<++>) :: Doc a -> Doc a -> Doc a
 x <++> y = x <> line <> y
@@ -35,32 +49,6 @@
 
 prettyTime :: UTCTime -> Doc a
 prettyTime = pretty . formatTime defaultTimeLocale "%F %T"
-
--- instance Pretty OpmlHead where
---   pretty h = hsep $ catMaybes
---                [ pretty <$> fromNullable (opmlTitle h)
---                , (text "created at:" <+>) . pretty <$> opmlCreated h
---                , (text "modified at:" <+>) . pretty <$> modified h
---                , (text "by" <+>) . pretty <$> fromNullable (ownerName h)
---                , angles . pretty <$> fromNullable (ownerEmail h)
---                ]
-
--- instance Pretty OutlineBase where
---   pretty b = pretty $ OPML.text b
-
--- instance Pretty OutlineSubscription where
---   pretty b = angles $ pretty $ xmlUri b
-
--- instance Pretty OpmlOutline where
---   pretty (OpmlOutlineGeneric base otype) = hsep
---                                              [ text "type:" <+> pretty otype
---                                              , pretty base
---                                              ]
---   pretty (OpmlOutlineSubscription base s) = text "Subscription:" <+> pretty base <+> pretty s
---   pretty (OpmlOutlineLink base uri) = text "Link:" <+> pretty base <+> pretty uri
-
--- instance Pretty Opml where
---   pretty o = text "OPML" <+> pretty (opmlVersion o) <++> indent 2 (pretty (opmlHead o) <++> (vsep . map pretty $ opmlOutlines o))
 
 prettyPerson :: AtomPerson -> Doc a
 prettyPerson p = pretty (unrefine $ personName p) <> email where
diff --git a/src/lib/Imm/XML.hs b/src/lib/Imm/XML.hs
--- a/src/lib/Imm/XML.hs
+++ b/src/lib/Imm/XML.hs
@@ -12,5 +12,5 @@
 -- }}}
 
 newtype Handle m = Handle
-  { parseXml :: URI -> LByteString -> m Feed
+  { parseXml :: URI -> LByteString -> m (FeedDefinition, [FeedItem])
   }
diff --git a/src/lib/Prelude.hs b/src/lib/Prelude.hs
--- a/src/lib/Prelude.hs
+++ b/src/lib/Prelude.hs
@@ -1,7 +1,19 @@
-module Prelude (io, module Relude, module Relude.Extra.Map) where
+module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where
 
-import           Relude           hiding (Handle, appendFile, force, readFile, writeFile)
+import           Relude           hiding (Handle, appendFile, force, readFile, stdout, writeFile)
 import           Relude.Extra.Map (lookup)
+import           Control.Exception.Safe
 
 io :: MonadIO m => IO a -> m a
 io = liftIO
+
+for :: [a] -> (a -> b) -> [b]
+for = flip map
+
+headThrow :: MonadThrow m => Exception e => e -> [a] -> m a
+headThrow _ (a:_) = return a
+headThrow e _ = throwM e
+
+headFail :: MonadFail m => String -> [a] -> m a
+headFail _ (a:_) = return a
+headFail e _ = fail e
diff --git a/src/lib/URI/ByteString/Extended.hs b/src/lib/URI/ByteString/Extended.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/URI/ByteString/Extended.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs                     #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE StandaloneDeriving        #-}
+{-# LANGUAGE TypeOperators             #-}
+module URI.ByteString.Extended (module URI.ByteString.Extended, module URI.ByteString) where
+
+import           Data.Aeson.Extended
+import           Data.Type.Equality
+import           Imm.Pretty
+import           URI.ByteString
+
+
+data AnyURI = forall a . AnyURI (URIRef a)
+
+deriving instance Show AnyURI
+instance Eq AnyURI where
+  (AnyURI a) == (AnyURI b) = case sameURIType a b of
+    Just Refl -> a == b
+    _         -> False
+
+instance Ord AnyURI where
+  compare (AnyURI a) (AnyURI b) = case (a, b) of
+    (URI{}, URI{})                 -> compare a b
+    (RelativeRef{}, RelativeRef{}) -> compare a b
+    (URI{}, RelativeRef{})         -> LT
+    (RelativeRef{}, URI{})         -> GT
+
+instance Pretty AnyURI where
+  pretty (AnyURI a@URI{})         = prettyURI a
+  pretty (AnyURI a@RelativeRef{}) = prettyURI a
+
+instance ToJSON AnyURI where
+  toJSON (AnyURI a@URI{})         = toJSON $ String $ decodeUtf8 $ serializeURIRef' a
+  toJSON (AnyURI a@RelativeRef{}) = toJSON $ String $ decodeUtf8 $ serializeURIRef' a
+
+instance FromJSON AnyURI where
+  parseJSON = withText "URI" $ \s ->
+    let bytes = encodeUtf8 s
+        uri = parseURI laxURIParserOptions bytes
+        relativeRef = parseRelativeRef laxURIParserOptions bytes
+    in either (const $ fail "Invalid URI") pure $ (AnyURI <$> uri) <> (AnyURI <$> relativeRef)
+
+
+sameURIType :: URIRef a1 -> URIRef a2 -> Maybe (URIRef a1 :~: URIRef a2)
+sameURIType a b = case (a, b) of
+  (URI{}, URI{})                 -> Just Refl
+  (RelativeRef{}, RelativeRef{}) -> Just Refl
+  _                              -> Nothing
+
+withAnyURI :: (forall a . URIRef a -> b) -> AnyURI -> b
+withAnyURI f (AnyURI a) = f a
+
+toAbsoluteURI :: Scheme -> AnyURI -> URI
+toAbsoluteURI scheme (AnyURI a) = toAbsolute scheme a
diff --git a/src/main/Alternate.hs b/src/main/Alternate.hs
--- a/src/main/Alternate.hs
+++ b/src/main/Alternate.hs
@@ -2,23 +2,19 @@
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE TypeFamilies      #-}
-module Alternate (AlternateException(..), resolveFeedURI) where
+module Alternate (AlternateException(..), extractAlternateLinks) where
 
 -- {{{ Imports
-import           Control.Exception.Safe
 import           Data.Aeson
-import qualified Data.ByteString.Char8  as Char8
-import qualified Data.Text              as Text
-import           Imm.Feed
-import qualified Imm.HTTP               as HTTP
-import           Imm.Logger             as Logger
+import qualified Data.ByteString.Char8   as Char8
+import           Imm.Link
+import           Imm.Logger              as Logger
 import           Imm.Pretty
 import           Pipes
-import           Pipes.ByteString       as Pipes (toHandle)
-import           Safe
-import           System.IO              (hClose)
+import           Pipes.ByteString        as Pipes (toHandle)
+import           System.IO               (hClose)
 import           System.Process.Typed
-import           URI.ByteString
+import           URI.ByteString.Extended
 -- }}}
 
 
@@ -47,15 +43,6 @@
   parseJSON _          = mzero
 
 
-data FeedType = RssXml | AtomXml
-  deriving(Eq, Ord, Read, Show)
-
-asFeedType :: MonadFail m => Text -> m FeedType
-asFeedType "application/rss+xml"  = pure RssXml
-asFeedType "application/atom+xml" = pure AtomXml
-asFeedType t                      = fail $ "Invalid feed type: " <> show t
-
-
 asFeedURI :: MonadFail m => URI -> Text -> m URI
 asFeedURI baseURI href = let bytes = encodeUtf8 @Text href in
   case parseURI laxURIParserOptions bytes of
@@ -78,41 +65,22 @@
   _   -> basePath <> "/" <> path
 
 
-data FeedLink = FeedLink
-  { _feedTitle :: Text
-  , _feedType  :: FeedType
-  , _feedURI   :: URI
-  } deriving(Eq, Ord, Show)
-
-asFeedLink :: MonadFail m => URI -> AlternateLink -> m FeedLink
-asFeedLink baseURI (AlternateLink a b c) = FeedLink a <$> asFeedType b <*> asFeedURI baseURI c
+asLink :: MonadFail m => URI -> AlternateLink -> m Link
+asLink baseURI (AlternateLink title type' uri) = Link (Just Alternate) title (parseMediaType type') . AnyURI <$> asFeedURI baseURI uri
 
 
-extractAlternateLinks :: MonadIO m => Logger.Handle IO -> Producer' ByteString IO () -> m [AlternateLink]
-extractAlternateLinks logger html = io $ withProcessWait pup $ \pupProcess -> do
+extractAlternateLinks :: MonadIO m => MonadFail m => Logger.Handle IO -> URI -> Producer ByteString IO () -> m [Link]
+extractAlternateLinks logger baseUri html = io $ withProcessWait pup $ \pupProcess -> do
   log logger Debug $ pretty $ show @String pupProcess
 
   runEffect $ html >-> toHandle (getStdin pupProcess)
   hClose (getStdin pupProcess)
 
   links <- getStdout pupProcess & atomically <&> decode <&> fromMaybe mempty
-  log logger Debug $ "Found alternate links:" <+> pretty links
+  log logger Info $ "Found alternate links:" <+> pretty links
 
-  return links
+  mapM (asLink baseUri) links
   where pup = proc "pup" ["html head link[rel=\"alternate\"] json{}"]
           & setStdin createPipe
           & setStdout byteStringOutput
           & setStderr nullStream
-
-
-resolveFeedURI :: m ~ IO => Logger.Handle m -> HTTP.Handle m -> FeedLocation -> m URI
-resolveFeedURI _ _ (FeedDirectURI uri) = pure uri
-resolveFeedURI logger httpClient (FeedAlternateLink uri title) = HTTP.withGet logger httpClient uri $ \html -> extractAlternateLinks logger html
-  <&> concatMap (asFeedLink uri)
-  <&> filterByTitle
-  <&> maximumByMay compareFeeds
-  >>= maybe (throwM $ FeedNotFound uri) (return . _feedURI)
-  where filterByTitle = if Text.null title then id else filter (\f -> _feedTitle f == title)
-        compareFeeds (FeedLink _ AtomXml _) (FeedLink _ RssXml _) = GT
-        compareFeeds (FeedLink _ RssXml _) (FeedLink _ AtomXml _) = LT
-        compareFeeds _ _                                          = EQ
diff --git a/src/main/Core.hs b/src/main/Core.hs
--- a/src/main/Core.hs
+++ b/src/main/Core.hs
@@ -3,55 +3,81 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE TypeFamilies          #-}
 module Core (
   markAsUnprocessed,
   subscribe,
   unsubscribe,
-  listFeeds,
+  describeFeeds,
   describeFeed,
-  importOPML,
+  downloadFeed,
 ) where
 
 -- {{{ Imports
+import           Alternate
+import           Database.Record
+-- (FeedItemRecord (..), FeedItemStatus (..), FeedRecord (..), Inserted)
+import qualified Database.Handle           as Database
+import           Output                    (putDocLn)
+import qualified Output
+
 import           Control.Exception.Safe
-import           Data.Conduit
-import qualified Data.Map                as Map
-import qualified Data.Set                as Set
-import           Data.Tree
-import qualified Imm.Database.Feed       as Database
+import qualified Data.Text                 as Text
 import           Imm.Feed
-import           Imm.Logger              as Logger
+import           Imm.HTTP                  as HTTP
+import           Imm.Link
+import           Imm.Logger                as Logger
 import           Imm.Pretty
-import           Refined
-import           Text.OPML.Conduit.Parse
-import           Text.OPML.Types         as OPML
-import           Text.XML                as XML ()
-import           Text.XML.Stream.Parse   as XML (def, force, parseBytes)
+import           Network.HTTP.Types.Header
+import           Pipes
+import           Safe
+import           Text.XML                  as XML ()
+import           URI.ByteString.Extended
 -- }}}
 
 
-markAsUnprocessed :: MonadThrow m
-                  => Logger.Handle m
-                  -> Database.Handle m
-                  -> FeedQuery
-                  -> m ()
-markAsUnprocessed logger database query = Database.resolveEntryKey database query
-  >>= mapM_ (Database.markAsUnprocessed logger database)
+markAsUnprocessed :: MonadThrow m => MonadIO m
+                 => Logger.Handle m
+                 -> Database.Handle m
+                 -> FeedQuery
+                 -> m ()
+markAsUnprocessed logger database QueryAll         = Database.markAllFeedsAsUnprocessed logger database
+markAsUnprocessed logger database (QueryByUID uid) = Database.markFeedAsUnprocessed logger database uid
 
 -- | Print database status for given feed(s)
-describeFeed :: MonadThrow m => Logger.Handle m -> Database.Handle m -> FeedQuery -> m ()
-describeFeed logger database feedQuery = do
-  entries <- Database.fetchQuery database (Database.matching feedQuery)
-  flushLogs logger
-  forM_ (Map.toList entries) $ \(index, entry) ->
-    log logger Info $ pretty index <+> Database.prettyEntry entry
+describeFeeds :: MonadThrow m => MonadIO m
+  => Output.Handle m -> Database.Handle m -> FeedQuery -> m ()
+describeFeeds output database QueryAll = do
+  feeds <- Database._fetchAllFeeds database
+  when (null feeds) $ putDocLn output "No subscriptions"
+  forM_ feeds $ describeFeed output database
+describeFeeds output database (QueryByUID uid) = do
+  feed <- Database._fetchFeed database uid
+  describeFeed output database feed
 
+
+describeFeed :: MonadThrow m => MonadIO m
+  => Output.Handle m -> Database.Handle m -> FeedRecord Inserted -> m ()
+describeFeed output database FeedRecord{..} = do
+  items <- Database._fetchItems database _feedKey
+
+  let newItems = length $ filter (not . _isProcessed . _itemStatus) items
+      description = pretty _feedDefinition
+        <++> pretty _feedStatus
+        <++> yellow (pretty newItems) <> "/" <> pretty (length items) <+> "new items"
+
+  putDocLn output $ pretty _feedKey <+> magenta (pretty _feedLocation)
+    <++> indent 3 description
+
+
 -- | Register the given set of feeds in database
-subscribe :: MonadCatch m => Logger.Handle m -> Database.Handle m -> FeedLocation -> Set Text -> m ()
-subscribe logger database feedLocation tags = do
-  index <- Database.register logger database feedLocation tags
-  log logger Info $ "Subscribed with index" <+> pretty index
+subscribe :: MonadCatch m => MonadIO m
+          => Logger.Handle m -> Output.Handle m -> Database.Handle m
+          -> FeedLocation -> Set Text -> m ()
+subscribe logger output database feedLocation tags = do
+  feedRecord <- Database.register logger database feedLocation tags
+  putDocLn output $ "Subscribed with index" <+> prettyKey feedRecord
 
 -- | Un-register the given set of feeds from database
 unsubscribe :: MonadThrow m
@@ -59,26 +85,31 @@
             -> Database.Handle m
             -> FeedQuery
             -> m ()
-unsubscribe logger database query = Database.resolveEntryKey database query
-  >>= Database.delete logger database
+unsubscribe logger database QueryAll         = Database.purge logger database
+unsubscribe logger database (QueryByUID uid) = Database.deleteFeed logger database uid
 
--- | List all subscribed feeds and their status
-listFeeds :: MonadCatch m => Logger.Handle m -> Database.Handle m -> m ()
-listFeeds logger database = do
-  entries <- Database.fetchAll database
-  flushLogs logger
-  when (null entries) $ log logger Warning "No subscription"
-  forM_ (zip [0..] $ Map.elems entries) $ \(i, entry) ->
-    log logger Info $ pretty (i :: Int) <+> Database.prettyShortEntry entry
+-- | Download feed data, following alternate links if necessary
+downloadFeed :: m ~ IO => Logger.Handle m -> HTTP.Handle m -> (Producer ByteString m () -> m a) -> FeedLocation -> m a
+downloadFeed logger httpClient f (FeedLocation uri title) = HTTP.withGet logger httpClient uri $ \response -> do
+  case getHeader hContentType response >>= parseMediaType of
+    Just MediaTypeRSS{}  -> f (responseBody response)
+    Just MediaTypeAtom{} -> f (responseBody response)
+    Just MediaTypeApplicationXML{} -> f (responseBody response)
+    Just MediaTypeTextXML{} -> f (responseBody response)
+    Just MediaTypeHTML{} -> extractAlternateLinks logger uri (responseBody response)
+      <&> filterByTitle
+      <&> maximumByMay compareFeeds
+      >>= maybe (throwM $ FeedNotFound uri) (\l -> downloadFeed logger httpClient f $ FeedLocation (toAbsoluteURI (Scheme "https") $ _linkURI l) mempty)
+    _ -> fail "Unexpected media type"
+  where filterByTitle = if Text.null title then id else filter (\l -> _linkTitle l == title)
+        compareFeeds (Link _ _ (Just MediaTypeAtom{}) _) (Link _ _ (Just MediaTypeRSS{}) _)  = GT
+        compareFeeds (Link _ _ (Just MediaTypeAtom{}) _) (Link _ _ (Just MediaTypeAtom{}) _) = EQ
+        compareFeeds (Link _ _ (Just MediaTypeAtom{}) _) _                                   = GT
+        compareFeeds (Link _ _ (Just MediaTypeRSS{}) _) (Link _ _ (Just MediaTypeAtom{}) _)  = LT
+        compareFeeds (Link _ _ (Just MediaTypeRSS{}) _) (Link _ _ (Just MediaTypeRSS{}) _)   = EQ
+        compareFeeds (Link _ _ (Just MediaTypeRSS{}) _) _                                    = GT
+        compareFeeds _ _                                                                     = EQ
 
 
--- | 'subscribe' to all feeds described by the OPML document provided in input
-importOPML :: MonadCatch m => Logger.Handle m -> Database.Handle m -> ConduitT () ByteString m () -> m ()
-importOPML logger database input = do
-  opml <- runConduit $ input .| XML.parseBytes def .| force "Invalid OPML" parseOpml
-  forM_ (opmlOutlines opml) $ importOPML' logger database mempty
-
-importOPML' :: MonadCatch m => Logger.Handle m -> Database.Handle m -> Set Text -> Tree OpmlOutline -> m ()
-importOPML' logger database _ (Node (OpmlOutlineGeneric b _) sub) = mapM_ (importOPML' logger database (Set.singleton . unrefine $ OPML.text b)) sub
-importOPML' logger database c (Node (OpmlOutlineSubscription _ s) _) = void $ subscribe logger database (FeedDirectURI $ xmlUri s) c
-importOPML' _ _ _ _ = return ()
+getHeader :: HeaderName -> Response a -> Maybe ByteString
+getHeader name response = response & responseHeaders & filter (\h-> fst h == name) & map snd & listToMaybe
diff --git a/src/main/Database.hs b/src/main/Database.hs
deleted file mode 100644
--- a/src/main/Database.hs
+++ /dev/null
@@ -1,164 +0,0 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedLists       #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TupleSections         #-}
-{-# LANGUAGE UndecidableInstances  #-}
--- | Implementation of "Imm.Database.Feed" based on a JSON file.
-module Database
-  ( JsonFileDatabase
-  , mkJsonFileDatabase
-  , defaultDatabase
-  , mkHandle
-  , JsonException(..)
-  , module Imm.Database.Feed
-  ) where
-
--- {{{ Imports
-import           Imm.Database.Feed           hiding (commit, delete1)
-import           Imm.Feed
-import           Imm.Pretty
-
-import           Control.Concurrent.STM.TVar (swapTVar)
-import           Control.Exception.Safe
-import           Data.Aeson
-import qualified Data.ByteString             as ByteString
-import           Data.ByteString.Lazy        (hPut)
-import qualified Data.Map                    as Map
-import           System.Directory
-import           System.FilePath
-import           System.IO                   hiding (Handle)
--- }}}
-
-data CacheStatus = Empty | Clean | Dirty
-  deriving(Eq, Ord, Read, Show)
-
-data JsonFileDatabase = JsonFileDatabase FilePath (Map FeedLocation Entry) CacheStatus
-
-instance Pretty JsonFileDatabase where
-  pretty (JsonFileDatabase file _ _) = "JSON database: " <+> pretty file
-
-mkJsonFileDatabase :: FilePath -> JsonFileDatabase
-mkJsonFileDatabase file = JsonFileDatabase file mempty Empty
-
--- | Default database is stored in @$XDG_CONFIG_HOME\/imm\/feeds.json@
-defaultDatabase :: IO (TVar JsonFileDatabase)
-defaultDatabase = do
-  databaseFile <- getXdgDirectory XdgConfig "imm/feeds.json"
-  newTVarIO $ mkJsonFileDatabase databaseFile
-
-
-data JsonException = UnableDecode
-  deriving(Eq, Show)
-
-instance Exception JsonException where
-  displayException _ = "Unable to parse JSON"
-
-
-mkHandle :: (MonadIO m, MonadMask m)
-         => TVar JsonFileDatabase -> Handle m
-mkHandle tvar = Handle
-  { _describeDatabase = pretty <$> readTVarIO tvar
-  , _fetch = \keys -> do
-      loadInCache tvar
-      database <- readTVarIO tvar
-      return $ Map.fromList $ do
-        key <- keys
-        entry <- maybeToList $ fetchFromCache key database
-        return (key, entry)
-  , _fetchAll = loadInCache tvar
-      >> getCache tvar
-      <&> Map.toList
-      <&> map snd
-      <&> zip [0..]
-      <&> Map.fromList
-  , _update = \key f -> loadInCache tvar >> atomically (modifyTVar' tvar $ updateInCache key f)
-  , _insert = \entries -> do
-      loadInCache tvar
-      atomically $ do
-        modifyTVar' tvar $ insertInCache entries
-        database <- readTVar tvar
-        return $ Map.fromList $ do
-          location <- entries <&> entryLocation
-          i <- maybeToList $ getIndex location database
-          return (location, i)
-  , _delete = \list -> loadInCache tvar >> atomically (modifyTVar' tvar $ deleteInCache list)
-  , _purge = loadInCache tvar >> atomically (modifyTVar' tvar purgeInCache)
-  , _commit = commit tvar
-  }
-
--- * Low-level implementation
-
-getIndex :: FeedLocation -> JsonFileDatabase -> Maybe Int
-getIndex location (JsonFileDatabase _ cache _) = Map.lookupIndex location cache
-
-loadInCache :: (MonadIO m, MonadMask m) => TVar JsonFileDatabase -> m ()
-loadInCache tvar = do
-  JsonFileDatabase file _ status <- readTVarIO tvar
-  when (status == Empty) $ do
-    database <- loadFromDisk file
-    atomically $ do
-      JsonFileDatabase _ _ status' <- readTVar tvar
-      when (status' == Empty) $ writeTVar tvar database
-
-loadFromDisk :: (MonadIO m, MonadMask m) => FilePath -> m JsonFileDatabase
-loadFromDisk file = do
-  liftIO $ createDirectoryIfMissing True $ takeDirectory file
-  fileContent <- io $ withBinaryFile file ReadWriteMode ByteString.hGetContents
-  cache <- fileContent
-    & fromEmpty "[]"
-    & decodeStrict
-    & fmap Map.fromList
-    & (`failWith` UnableDecode)
-  return $ JsonFileDatabase file cache Clean
-  where fromEmpty x "" = x
-        fromEmpty _ y  = y
-
-getCache :: MonadIO m => TVar JsonFileDatabase -> m (Map FeedLocation Entry)
-getCache tvar = do
-  JsonFileDatabase _ cache _ <- readTVarIO tvar
-  return cache
-
-fetchFromCache :: EntryKey -> JsonFileDatabase -> Maybe (Int, Entry)
-fetchFromCache (ByLocation location) (JsonFileDatabase _ cache _) = (,)
-  <$> Map.lookupIndex location cache
-  <*> Map.lookup location cache
-fetchFromCache (ById i) (JsonFileDatabase _ cache _) = if i >= 0 && i < Map.size cache
-  then Just $ (i,) $ snd $ Map.elemAt i cache
-  else Nothing
-
-
-insertInCache :: [Entry] -> JsonFileDatabase -> JsonFileDatabase
-insertInCache entries (JsonFileDatabase file cache _) = JsonFileDatabase file newCache Dirty where
-  newCache = Map.union cache $ Map.fromList $ map (\entry -> (entryLocation entry, entry)) entries
-
-updateInCache :: [EntryKey] -> (Entry -> Entry) -> JsonFileDatabase -> JsonFileDatabase
-updateInCache keys f (JsonFileDatabase file cache _) = JsonFileDatabase file newCache Dirty where
-  newCache = foldr update1 cache keys
-  update1 (ByLocation location) = Map.update (Just . f) location
-  update1 (ById i)              = Map.updateAt (const $ Just . f) i
-
-deleteInCache :: [EntryKey] -> JsonFileDatabase -> JsonFileDatabase
-deleteInCache keys (JsonFileDatabase file oldCache _) = JsonFileDatabase file newCache Dirty where
-  newCache = foldr delete1 oldCache keys
-  delete1 (ByLocation location) = Map.delete location
-  delete1 (ById i)              = Map.deleteAt i
-
-purgeInCache :: JsonFileDatabase -> JsonFileDatabase
-purgeInCache (JsonFileDatabase file _ _) = JsonFileDatabase file mempty Dirty
-
-commit :: (MonadIO m)
-       => TVar JsonFileDatabase -> m ()
-commit tvar = do
-  JsonFileDatabase file cache status <- atomically $ do
-    database@(JsonFileDatabase file cache status) <- readTVar tvar
-    when (status == Dirty) $ void $ swapTVar tvar $ JsonFileDatabase file cache Clean
-    return database
-
-  when (status == Dirty) $ liftIO $ withFile file WriteMode $ \h -> hPut h $ encode $ Map.toList cache
-
-
--- | Wrap a 'Maybe' value in 'MonadThrow'
-failWith :: (MonadThrow m, Exception e) => Maybe a -> e -> m a
-failWith x e = maybe (throwM e) return x
diff --git a/src/main/Database/Async.hs b/src/main/Database/Async.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Database/Async.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
+module Database.Async (withAsyncHandle) where
+
+import           Database.Handle
+import           Output                    (putDocLn)
+import qualified Output
+
+import           Control.Concurrent.Async
+import           Control.Concurrent.STM.TMChan
+import           Control.Exception.Safe
+import           Imm.Logger                    (LogLevel (..), log)
+import qualified Imm.Logger                    as Logger
+import           Imm.Pretty
+
+
+-- | Run an existing database handle in a separate thread
+withAsyncHandle :: m ~ IO => Logger.Handle m -> Output.Handle m -> Handle m -> (Handle m -> m ()) -> m ()
+withAsyncHandle logger output database f = do
+  channel <- newTMChanIO
+
+  thread <- async $ fix $ \recurse -> do
+    maybeMessage <- atomically $ readTMChan channel
+    forM_ maybeMessage $ \message -> do
+      interpret database message
+      recurse
+
+  log logger Debug "Database thread started"
+  catchAny (f $ command channel) $ \e -> do
+    log logger Error $ pretty $ displayException e
+    putDocLn output $ pretty $ displayException e
+  log logger Debug "Closing database thread..."
+  atomically (closeTMChan channel) >> wait thread
+
+withMVar :: MonadIO m => TMChan a -> ((b -> m ()) -> a) -> m b
+withMVar channel message = do
+  result <- newEmptyMVar
+  atomically $ writeTMChan channel (message $ putMVar result)
+  takeMVar result
+
+withMVarE :: (MonadIO m, MonadThrow m, Exception e)
+  => TMChan a -> ((Either e b -> m ()) -> a) -> m b
+withMVarE channel message = do
+  result <- newEmptyMVar
+  atomically $ writeTMChan channel (message $ putMVar result)
+  takeMVar result >>= either throwM return
+
+asyncCommand :: MonadIO m => TMChan a -> (m () -> a) -> m ()
+asyncCommand channel message = do
+  atomically $ writeTMChan channel (message $ return ())
+
+command :: MonadIO m => MonadThrow m => TMChan (HandleF (m ())) -> Handle m
+command channel = Handle
+  { _describeDatabase = withMVar channel DescribeDatabase
+  , _fetchAllFeeds = withMVar channel FetchAllFeeds
+  , _fetchFeed = withMVarE channel . FetchFeed
+  , _fetchAllItems = withMVar channel FetchAllItems
+  , _fetchItems = withMVar channel . FetchItems
+  , _fetchItem = withMVarE channel . FetchItem
+  , _updateFeedDefinition = asyncCommand channel . UpdateFeedDefinition
+  , _updateFeedStatus = asyncCommand channel . UpdateFeedStatus
+  , _updateItemStatus = asyncCommand channel . UpdateItemStatus
+  , _insertFeed = withMVarE channel . InsertFeed
+  , _insertItem = withMVar channel . InsertItem
+  , _deleteFeed = asyncCommand channel . DeleteFeed
+  , _purge = asyncCommand channel Purge
+  , _commit = asyncCommand channel Commit
+  }
diff --git a/src/main/Database/Handle.hs b/src/main/Database/Handle.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Database/Handle.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE DeriveFunctor        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Database.Handle
+  ( -- * 1st-level primitives
+    HandleF(..)
+  , Handle(..)
+  , interpret
+  , DatabaseException(..)
+  , -- * 2nd-level primitives
+    insertFeed
+  , deleteFeed
+  , insertItem
+  , purge
+  , commit
+  , -- * 3rd-level primitives
+    register
+  , markItemAsProcessed
+  , markFeedAsUnprocessed
+  , markAllFeedsAsUnprocessed
+  , -- * Re-exports
+    module Database.Record
+  ) where
+
+import           Database.Record        hiding (markFeedAsUnprocessed, markItemAsProcessed)
+import qualified Database.Record        as Record
+
+import           Control.Exception.Safe hiding (handle)
+import           Control.Monad.Time
+import           Imm.Feed
+import           Imm.Logger             (LogLevel (..), log)
+import qualified Imm.Logger             as Logger
+import           Imm.Pretty
+import           URI.ByteString         hiding (OtherError)
+
+
+-- | 1st-level primitives
+data Handle m = Handle
+  { _describeDatabase     :: m (Doc AnsiStyle)
+  , _fetchAllFeeds        :: m [FeedRecord Inserted]
+  , _fetchFeed            :: UID -> m (FeedRecord Inserted)
+  , _fetchAllItems        :: m [FeedItemRecord Inserted]
+  , _fetchItems           :: UID -> m [FeedItemRecord Inserted]
+  , _fetchItem            :: UID -> m (FeedItemRecord Inserted)
+  , _updateFeedDefinition :: FeedRecord Inserted -> m ()
+  , _updateFeedStatus     :: FeedRecord Inserted -> m ()
+  , _updateItemStatus     :: FeedItemRecord Inserted -> m ()
+  , _insertFeed           :: FeedRecord NotInserted -> m (FeedRecord Inserted)
+  , _insertItem           :: FeedItemRecord NotInserted -> m (FeedItemRecord Inserted)
+  , _deleteFeed           :: UID -> m ()
+  , _purge                :: m ()
+  , _commit               :: m ()
+  }
+
+-- | Database functor
+data HandleF a
+  = DescribeDatabase (Doc AnsiStyle -> a)
+  | FetchAllFeeds ([FeedRecord Inserted] -> a)
+  | FetchFeed UID (Either SomeException (FeedRecord Inserted) -> a)
+  | FetchAllItems ([FeedItemRecord Inserted] -> a)
+  | FetchItems UID ([FeedItemRecord Inserted] -> a)
+  | FetchItem UID (Either SomeException (FeedItemRecord Inserted) -> a)
+  | UpdateFeedDefinition (FeedRecord Inserted) a
+  | UpdateFeedStatus (FeedRecord Inserted) a
+  | UpdateItemStatus (FeedItemRecord Inserted) a
+  | InsertFeed (FeedRecord NotInserted) (Either SomeException (FeedRecord Inserted) -> a)
+  | InsertItem (FeedItemRecord NotInserted) (FeedItemRecord Inserted -> a)
+  | DeleteFeed UID a
+  | Purge a
+  | Commit a
+  deriving (Functor)
+
+interpret :: MonadCatch m => Handle m -> HandleF (m a) -> m a
+interpret database (DescribeDatabase f)            = _describeDatabase database >>= f
+interpret database (FetchAllFeeds f)               = _fetchAllFeeds database >>= f
+interpret database (FetchFeed uid f)               = tryAny (_fetchFeed database uid) >>= f
+interpret database (FetchAllItems f)               = _fetchAllItems database >>= f
+interpret database (FetchItems uid f)              = _fetchItems database uid >>= f
+interpret database (FetchItem uid f)               = tryAny (_fetchItem database uid) >>= f
+interpret database (UpdateFeedDefinition record f) = _updateFeedDefinition database record >> f
+interpret database (UpdateFeedStatus record f)     = _updateFeedStatus database record >> f
+interpret database (UpdateItemStatus record f)     = _updateItemStatus database record >> f
+interpret database (InsertFeed record f)           = tryAny (_insertFeed database record) >>= f
+interpret database (InsertItem record f)           = _insertItem database record >>= f
+interpret database (DeleteFeed uid f)              = _deleteFeed database uid >> f
+interpret database (Purge f)                       = _purge database >> f
+interpret database (Commit f)                      = _commit database >> f
+
+data DatabaseException
+  = NotCommitted
+  | NotDeleted [FeedLocation]
+  | FeedNotFound UID
+  | FeedsNotInserted [FeedRecord NotInserted]
+  | ItemsNotInserted [FeedItemRecord NotInserted]
+  | NotPurged
+  | NotUpdated FeedLocation
+  | UnableFetchAll
+  | InvalidURI URIParseError
+  | OtherError Text
+  deriving(Eq, Show)
+
+instance Exception DatabaseException where
+  displayException = show . pretty
+
+instance Pretty DatabaseException where
+  pretty NotCommitted = "Unable to commit database changes."
+  pretty (NotDeleted x) = "Unable to delete the following entries in database:" <++> indent 2 (vsep $ map pretty x)
+  pretty (FeedNotFound x) = "Unable to find feed in database using UID" <+> pretty x
+  pretty (FeedsNotInserted x) = "Unable to insert the following feeds in database:" <++> indent 2 (vsep $ map (pretty . _feedLocation) x)
+  pretty (ItemsNotInserted x) = "Unable to insert the following items in database:" <++> indent 2 (vsep $ map (pretty . _itemFeedKey) x)
+  pretty NotPurged = "Unable to purge feed database"
+  pretty (NotUpdated x) = "Unable to update the following entry in database:" <++> indent 2 (pretty x)
+  pretty UnableFetchAll = "Unable to fetch all entries from database."
+  pretty (InvalidURI e) = pretty $ show @Text e
+  pretty (OtherError e) = "Other database error:" <+> pretty e
+
+
+-- * 2nd-level primitives
+
+insertFeed :: Monad m => Logger.Handle m -> Handle m -> FeedRecord NotInserted -> m (FeedRecord Inserted)
+insertFeed logger handle i = do
+  log logger Info $ "Inserting feed" <+> magenta (prettyName $ _feedDefinition i)
+  _insertFeed handle i
+
+deleteFeed :: Monad m => Logger.Handle m -> Handle m -> UID -> m ()
+deleteFeed logger handle k = do
+  log logger Info $ "Deleting feed" <+> magenta (pretty k) <+> "..."
+  _deleteFeed handle k
+
+insertItem :: Monad m => Logger.Handle m -> Handle m -> FeedItemRecord NotInserted -> m (FeedItemRecord Inserted)
+insertItem logger handle i = do
+  log logger Info $ "Inserting item" <+> magenta (prettyName $ _itemDefinition i)
+  _insertItem handle i
+
+purge :: Monad m => Logger.Handle m -> Handle m -> m ()
+purge logger handle = do
+  log logger Info "Purging database..."
+  _purge handle
+
+commit :: Monad m => Logger.Handle m -> Handle m -> m ()
+commit logger handle = do
+  log logger Debug "Committing database transaction..."
+  _commit handle
+  log logger Debug "Database transaction committed"
+
+
+-- * 3rd-level primitives
+
+register :: MonadThrow m => Logger.Handle m -> Handle m -> FeedLocation -> Set Text -> m (FeedRecord Inserted)
+register logger database feedLocation tags = do
+ log logger Info $ "Registering feed" <+> magenta (pretty feedLocation) <> "..."
+ insertFeed logger database $ mkFeedRecord feedLocation definition status
+ where definition = FeedDefinition mempty
+       status = FeedStatus tags mzero
+
+markItemAsProcessed :: MonadThrow m => MonadTime m
+  => Logger.Handle m -> Handle m -> FeedItemRecord Inserted -> m ()
+markItemAsProcessed logger database item = do
+  log logger Debug $ "Marking item as processed:" <+> prettyName item <> "..."
+  _updateItemStatus database $ item { _itemStatus = Record.markItemAsProcessed $ _itemStatus item }
+
+markFeedAsUnprocessed :: MonadThrow m => Logger.Handle m -> Handle m -> UID -> m ()
+markFeedAsUnprocessed logger database key = do
+  log logger Debug $ "Marking as unprocessed:" <+> pretty key <> "..."
+  feed <- _fetchFeed database key
+  items <- _fetchItems database key
+  forM_ items $ \item -> _updateItemStatus database $ item { _itemStatus = markItemAsUnprocessed $ _itemStatus item }
+  _updateFeedStatus database $ feed { _feedStatus = Record.markFeedAsUnprocessed $ _feedStatus feed }
+
+markAllFeedsAsUnprocessed :: MonadThrow m => Logger.Handle m -> Handle m -> m ()
+markAllFeedsAsUnprocessed logger database = do
+  log logger Debug $ "Marking all feeds as unprocessed..."
+  feeds <- _fetchAllFeeds database
+  items <- _fetchAllItems database
+  forM_ items $ \item -> _updateItemStatus database $ item { _itemStatus = markItemAsUnprocessed $ _itemStatus item }
+  forM_ feeds $ \feed -> _updateFeedStatus database $ feed { _feedStatus = Record.markFeedAsUnprocessed $ _feedStatus feed }
diff --git a/src/main/Database/ReadOnly.hs b/src/main/Database/ReadOnly.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Database/ReadOnly.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Database.ReadOnly where
+
+import           Database.Handle
+import           Imm.Logger      (LogLevel (..), log)
+import qualified Imm.Logger      as Logger
+import           Imm.Pretty
+
+readOnly :: MonadFail m => Logger.Handle m -> Handle m -> Handle m
+readOnly logger handle = handle
+  { _describeDatabase = do
+      output <- _describeDatabase handle
+      return $ output <+> yellow (brackets "read only")
+  , _updateFeedDefinition = \record -> log logger Debug $ "Not updating feed" <+> prettyKey record
+  , _updateFeedStatus = \record -> log logger Debug $ "Not updating feed" <+> prettyKey record
+  , _updateItemStatus = \record -> log logger Debug $ "Not updating item" <+> prettyKey record
+  , _insertFeed = \record -> fail $ "Not inserting feed " <> show (prettyKey record)
+  , _insertItem = \record -> fail $ "Not inserting item " <> show (prettyItemRecord record)
+  , _deleteFeed = \key -> log logger Debug $ "Not deleting feed" <+> pretty key
+  , _purge = log logger Debug "Not purging database"
+  , _commit = log logger Debug "Not committing database"
+  }
diff --git a/src/main/Database/Record.hs b/src/main/Database/Record.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Database/Record.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE RecordWildCards      #-}
+{-# LANGUAGE StandaloneDeriving   #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Database.Record
+  ( FeedStatus(..)
+  , markFeedAsUnprocessed
+  , touchFeed
+  , FeedItemStatus(..)
+  , markItemAsProcessed
+  , markItemAsUnprocessed
+  , FeedRecord(..)
+  , mkFeedRecord
+  , FeedItemRecord(..)
+  , prettyItemRecord
+  , mkFeedItemRecord
+  , Inserted
+  , NotInserted
+  ) where
+
+import           Control.Monad.Time
+import           Data.Aeson
+import           Data.Time
+import           Imm.Feed
+import           Imm.Pretty
+
+
+-- | Stateful information on a feed
+data FeedStatus = FeedStatus
+  { _feedTags       :: Set Text
+  , _feedLastUpdate :: Maybe UTCTime
+  } deriving(Eq, Generic, Ord, Read, Show, Typeable)
+
+feedStatusOptions :: Options
+feedStatusOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_' . drop (length @[] "_feed")
+  , omitNothingFields = True
+  }
+
+instance ToJSON FeedStatus where
+  toJSON     = genericToJSON feedStatusOptions
+  toEncoding = genericToEncoding feedStatusOptions
+
+instance FromJSON FeedStatus where
+  parseJSON = genericParseJSON feedStatusOptions
+
+instance Pretty FeedStatus where
+  pretty FeedStatus{..} = tags <++> "Last update:" <+> lastUpdate
+    where tags = sep $ map ((<>) "#" . pretty) $ toList _feedTags
+          lastUpdate = maybe "never" prettyTime _feedLastUpdate
+
+markFeedAsUnprocessed :: FeedStatus -> FeedStatus
+markFeedAsUnprocessed status = status
+  { _feedLastUpdate = Nothing
+  }
+
+touchFeed :: FeedStatus -> IO FeedStatus
+touchFeed status = do
+  utcTime <- currentTime
+  return $ status { _feedLastUpdate = Just utcTime }
+
+
+-- | Stateful information on a feed item
+newtype FeedItemStatus = FeedItemStatus
+  { _isProcessed :: Bool
+  } deriving(Eq, Generic, Ord, Read, Show, Typeable)
+
+instance Pretty FeedItemStatus where
+  pretty FeedItemStatus{..} = pretty _isProcessed
+
+feedItemStatusOptions :: Options
+feedItemStatusOptions = defaultOptions
+  { fieldLabelModifier = camelTo2 '_'
+  , omitNothingFields = True
+  }
+
+instance ToJSON FeedItemStatus where
+  toJSON     = genericToJSON feedItemStatusOptions
+  toEncoding = genericToEncoding feedItemStatusOptions
+
+instance FromJSON FeedItemStatus where
+  parseJSON = genericParseJSON feedItemStatusOptions
+
+markItemAsProcessed :: FeedItemStatus -> FeedItemStatus
+markItemAsProcessed status = status { _isProcessed = True }
+
+markItemAsUnprocessed :: FeedItemStatus -> FeedItemStatus
+markItemAsUnprocessed status = status { _isProcessed = False }
+
+
+-- | Consistent record of information for a single feed
+data FeedRecord status = FeedRecord
+  { _feedKey        :: StatusUID status
+  , _feedLocation   :: FeedLocation
+  , _feedDefinition :: FeedDefinition
+  , _feedStatus     :: FeedStatus
+  }
+
+deriving instance (Eq (StatusUID s)) => Eq (FeedRecord s)
+deriving instance (Ord (StatusUID s)) => Ord (FeedRecord s)
+deriving instance (Show (StatusUID s)) => Show (FeedRecord s)
+
+instance Pretty (PrettyKey (FeedRecord Inserted)) where
+  pretty (PrettyKey record) = pretty $ _feedKey record
+
+instance Pretty (PrettyKey (FeedRecord NotInserted)) where
+  pretty (PrettyKey record) = pretty $ _feedLocation record
+
+mkFeedRecord :: FeedLocation -> FeedDefinition -> FeedStatus -> FeedRecord NotInserted
+mkFeedRecord = FeedRecord ()
+
+
+-- | Consistent record of information for a single feed item
+data FeedItemRecord status = FeedItemRecord
+  { _itemKey        :: StatusUID status
+  , _itemFeedKey    :: UID
+  , _itemDefinition :: FeedItem
+  , _itemStatus     :: FeedItemStatus
+  }
+
+deriving instance (Eq (StatusUID s)) => Eq (FeedItemRecord s)
+deriving instance (Ord (StatusUID s)) => Ord (FeedItemRecord s)
+deriving instance (Show (StatusUID s)) => Show (FeedItemRecord s)
+
+instance Pretty (PrettyKey (FeedItemRecord Inserted)) where
+  pretty (PrettyKey record) = pretty $ _itemKey record
+
+instance Pretty (PrettyName (FeedItemRecord a)) where
+  pretty (PrettyName record) = pretty $ _itemTitle $ _itemDefinition record
+
+prettyItemRecord :: Pretty (StatusUID s) => FeedItemRecord s -> Doc AnsiStyle
+prettyItemRecord FeedItemRecord{..} = pretty _itemKey <+> magenta (pretty _itemFeedKey)
+  <++> pretty _itemDefinition
+  <++> pretty _itemStatus
+
+mkFeedItemRecord :: UID -> FeedItem -> FeedItemStatus -> FeedItemRecord NotInserted
+mkFeedItemRecord = FeedItemRecord ()
+
+
+data Inserted
+data NotInserted
+
+type family StatusUID s where
+  StatusUID Inserted = UID
+  StatusUID NotInserted = ()
diff --git a/src/main/Database/SQLite.hs b/src/main/Database/SQLite.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Database/SQLite.hs
@@ -0,0 +1,295 @@
+{-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE ImpredicativeTypes    #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
+module Database.SQLite
+  ( DatabaseSQLite(..)
+  , defaultDatabase
+  , mkHandle
+  ) where
+
+import           Database.Handle                          hiding (deleteFeed, insertFeed, insertItem, purge)
+
+import           Data.Aeson
+import           Database.Beam
+import           Database.Beam.Backend.SQL                (BeamSqlBackend, HasSqlValueSyntax (..))
+import           Database.Beam.Backend.SQL.BeamExtensions
+-- import           Database.Beam.Migrate
+import           Database.Beam.Sqlite                     (runBeamSqlite)
+import           Database.SQLite.Simple
+import           Imm.Feed
+import           Imm.Pretty
+import           System.Directory
+
+-- * Schema
+
+data FeedLocationT f = FeedLocationT
+  { _locationID    :: Columnar f Int32
+  , _locationValue :: Columnar f FeedLocation
+  } deriving(Generic, Beamable)
+
+instance Table FeedLocationT where
+  data PrimaryKey FeedLocationT f = FeedLocationKey (Columnar f Int32)
+    deriving(Generic, Beamable)
+  primaryKey = FeedLocationKey . _locationID
+
+
+data FeedT f = Feed
+  { _feedKeyT        :: PrimaryKey FeedLocationT f
+  , _feedDefinitionT :: Columnar f FeedDefinition
+  , _feedStatusT     :: Columnar f FeedStatus
+  } deriving(Generic, Beamable)
+
+instance Table FeedT where
+  data PrimaryKey FeedT f = FeedKey (PrimaryKey FeedLocationT f)
+    deriving(Generic, Beamable)
+  primaryKey = FeedKey . _feedKeyT
+
+
+data FeedItemT f = FeedItemT
+  { _itemKeyT        :: Columnar f Int32
+  , _itemFeedKeyT    :: PrimaryKey FeedLocationT f
+  , _itemDefinitionT :: Columnar f FeedItem
+  , _itemStatusT     :: Columnar f FeedItemStatus
+  } deriving(Generic, Beamable)
+
+instance Table FeedItemT where
+  data PrimaryKey FeedItemT f = FeedItemKey (Columnar f Int32)
+    deriving(Generic, Beamable)
+  primaryKey = FeedItemKey . _itemKeyT
+
+
+data FeedDatabase f = FeedDatabase
+  { _feedLocations :: f (TableEntity FeedLocationT)
+  , _feeds         :: f (TableEntity FeedT)
+  , _feedItems     :: f (TableEntity FeedItemT)
+  } deriving (Generic, Database be)
+
+
+feedDatabase :: DatabaseSettings be FeedDatabase
+feedDatabase = defaultDbSettings `withDbModification`
+  dbModification
+    { _feedItems = modifyTableFields tableModification
+        { _itemKeyT = fieldNamed "key"
+        , _itemFeedKeyT = FeedLocationKey $ fieldNamed "feed_key"
+        , _itemDefinitionT = fieldNamed "definition"
+        , _itemStatusT = fieldNamed "status"
+        }
+    , _feeds = modifyTableFields tableModification
+        { _feedKeyT = FeedLocationKey $ fieldNamed "key"
+        , _feedDefinitionT = fieldNamed "definition"
+        , _feedStatusT = fieldNamed "status"
+        }
+    , _feedLocations = modifyTableFields tableModification
+        { _locationID = fieldNamed "key"
+        , _locationValue = fieldNamed "value"
+        }
+    }
+
+
+feedLocationsTable :: DatabaseEntity be FeedDatabase (TableEntity FeedLocationT)
+feedLocationsTable = _feedLocations feedDatabase
+
+feedsTable :: DatabaseEntity be FeedDatabase (TableEntity FeedT)
+feedsTable = _feeds feedDatabase
+
+feedItemsTable :: DatabaseEntity be FeedDatabase (TableEntity FeedItemT)
+feedItemsTable = _feedItems feedDatabase
+
+-- * Queries
+
+fetchAllFeeds :: _ [FeedRecord Inserted]
+fetchAllFeeds = fmap (map asFeedRecord) $ runSelectReturningList $ select $ do
+  feed <- feedsTable & all_
+  location <- feedLocationsTable & all_
+
+  guard_ $ _feedKeyT feed `references_` location
+
+  pure (location, feed)
+
+asFeedRecord :: f ~ Identity => (FeedLocationT f, FeedT f) -> FeedRecord Inserted
+asFeedRecord (locationT, feed) = FeedRecord
+  (fromIntegral $ _locationID locationT)
+  (_locationValue locationT)
+  (_feedDefinitionT feed)
+  (_feedStatusT feed)
+
+fetchFeed :: UID -> _
+fetchFeed uid = select (queryFeed uid) & runSelectReturningOne
+  >>= maybe (fail $ "Feed not found: " <> show uid) return
+  <&> asFeedRecord
+
+queryFeed :: UID -> _
+queryFeed uid = do
+  feed <- feedsTable & all_
+  location <- feedLocationsTable & all_
+
+  guard_ $ _feedKeyT feed `references_` location
+  guard_ $ _locationID location ==. val_ (fromIntegral uid)
+
+  pure (location, feed)
+
+fetchItem :: UID -> _
+fetchItem uid = feedItemsTable
+  & all_
+  & filter_ (\i -> primaryKey i ==. val_ (FeedItemKey $ fromIntegral uid))
+  & select
+  & runSelectReturningOne
+  >>= maybe (fail $ "Item not found: " <> show uid) return
+  <&> asFeedItemRecord
+
+fetchAllItems :: _ [FeedItemRecord Inserted]
+fetchAllItems = select (feedItemsTable & all_)
+  & runSelectReturningList
+  <&> map asFeedItemRecord
+
+fetchItems :: UID -> _
+fetchItems uid = select (queryItems uid) & runSelectReturningList <&> map asFeedItemRecord
+
+queryItems :: UID -> _
+queryItems uid = do
+  item <- feedItemsTable & all_
+  guard_ $ _itemFeedKeyT item ==. val_ (FeedLocationKey $ fromIntegral uid)
+  pure item
+
+
+asFeedItemRecord :: FeedItemT Identity -> FeedItemRecord Inserted
+asFeedItemRecord item = FeedItemRecord
+  (fromIntegral $ _itemKeyT item)
+  (fromIntegral feedKey)
+  (_itemDefinitionT item)
+  (_itemStatusT item)
+  where FeedLocationKey feedKey = _itemFeedKeyT item
+
+
+deleteFeed :: UID -> _ ()
+deleteFeed uid = do
+  -- runDelete $ delete feedItemsTable $ \item -> _itemFeedKeyT item ==. val_ (FeedLocationKey $ fromIntegral uid)
+  -- runDelete $ delete feedsTable $ \feed -> _feedKeyT feed ==. val_ (FeedLocationKey $ fromIntegral uid)
+  runDelete $ delete feedLocationsTable $ \location -> _locationID location ==. val_ (fromIntegral uid)
+
+insertFeed :: FeedRecord NotInserted -> _ (FeedRecord Inserted)
+insertFeed record = do
+  location <- insertFeedLocation $ _feedLocation record
+  let value = Feed (primaryKey location) (_feedDefinition record) (_feedStatus record)
+  feed <- insertValues [value]
+    & insert feedsTable
+    & runInsertReturningList
+    >>= headFail (displayException $ FeedsNotInserted [record])
+  return $ asFeedRecord (location, feed)
+
+insertFeedLocation :: FeedLocation -> _
+insertFeedLocation location = insertExpressions [FeedLocationT default_ (val_ location)]
+  & insert feedLocationsTable
+  & runInsertReturningList
+  >>= headFail ("Unable to insert feed location " <> show location)
+
+insertItem :: FeedItemRecord NotInserted -> _
+insertItem record = do
+  inserted <- insertExpressions [FeedItemT default_ (val_ $ FeedLocationKey $ fromIntegral $ _itemFeedKey record) (val_ $ _itemDefinition record) (val_ $ _itemStatus record)]
+    & insert feedItemsTable
+    & runInsertReturningList
+    >>= headFail (displayException $ ItemsNotInserted [record])
+  return $ FeedItemRecord (fromIntegral $ _itemKeyT inserted) (_itemFeedKey record) (_itemDefinition record) (_itemStatus record)
+
+purge = runDelete $ delete feedLocationsTable $ const $ val_ True
+
+updateItemStatus :: FeedItemRecord Inserted -> _
+updateItemStatus record = runUpdate $ update feedItemsTable
+  (\item -> _itemStatusT item <-. val_ (_itemStatus record))
+  (\item -> primaryKey item ==. val_ (FeedItemKey $ fromIntegral $ _itemKey record))
+
+updateFeedDefinition :: FeedRecord Inserted -> _
+updateFeedDefinition record = runUpdate $ update feedsTable
+  (\feed -> _feedDefinitionT feed <-. val_ (_feedDefinition record))
+  (\feed -> primaryKey feed ==. val_ (FeedKey $ FeedLocationKey $ fromIntegral $ _feedKey record))
+
+updateFeedStatus :: FeedRecord Inserted -> _
+updateFeedStatus record = runUpdate $ update feedsTable
+  (\feed -> _feedStatusT feed <-. val_ (_feedStatus record))
+  (\feed -> primaryKey feed ==. val_ (FeedKey $ FeedLocationKey $ fromIntegral $ _feedKey record))
+
+-- * Handle
+
+newtype DatabaseSQLite = DatabaseSQLite
+ { _sqliteFile           :: FilePath
+ }
+
+instance Pretty DatabaseSQLite where
+ pretty db = "SQLite database: " <+> pretty (_sqliteFile db)
+
+-- | Default database is stored in @$XDG_CONFIG_HOME\/imm\/database.sqlite@
+defaultDatabase :: IO DatabaseSQLite
+defaultDatabase = DatabaseSQLite <$> getXdgDirectory XdgConfig "imm/database.sqlite"
+
+
+createTables :: Connection -> IO ()
+createTables conn = do
+  execute_ conn "CREATE TABLE IF NOT EXISTS locations (key INTEGER NOT NULL PRIMARY KEY, value BLOB NOT NULL UNIQUE);"
+  execute_ conn "CREATE TABLE IF NOT EXISTS feeds ( \
+    \ key INTEGER NOT NULL PRIMARY KEY, definition BLOB NOT NULL, status BLOB NOT NULL, \
+    \ CONSTRAINT fk_feeds FOREIGN KEY (key) REFERENCES locations(key) ON DELETE CASCADE \
+    \ );"
+  execute_ conn "CREATE TABLE IF NOT EXISTS items ( \
+    \ key INTEGER NOT NULL PRIMARY KEY, feed_key INTEGER NOT NULL, definition BLOB NOT NULL, status BLOB NOT NULL, \
+    \ CONSTRAINT fk_feeds FOREIGN KEY (feed_key) REFERENCES locations(key) ON DELETE CASCADE \
+    \ );"
+
+mkHandle :: DatabaseSQLite -> IO (Handle IO)
+mkHandle database = do
+  conn <- open $ _sqliteFile database
+  createTables conn
+  execute_ conn "PRAGMA foreign_keys = ON;"
+
+  return $ Handle
+    { _describeDatabase = return $ pretty database
+    , _fetchAllFeeds = runBeamSqlite conn fetchAllFeeds
+    , _fetchFeed = runBeamSqlite conn . fetchFeed
+    , _fetchItems = runBeamSqlite conn . fetchItems
+    , _fetchAllItems = runBeamSqlite conn fetchAllItems
+    , _fetchItem = runBeamSqlite conn . fetchItem
+    , _updateFeedDefinition = runBeamSqlite conn . updateFeedDefinition
+    , _updateFeedStatus = runBeamSqlite conn . updateFeedStatus
+    , _updateItemStatus = runBeamSqlite conn . updateItemStatus
+    , _insertFeed = runBeamSqlite conn . insertFeed
+    , _insertItem = runBeamSqlite conn . insertItem
+    , _deleteFeed = runBeamSqlite conn . deleteFeed
+    , _purge = runBeamSqlite conn purge
+    , _commit = return ()
+    }
+
+instance (BeamSqlBackend be, FromBackendRow be LByteString) => FromBackendRow be FeedLocation where
+  fromBackendRow = fromBackendRow <&> decode >>= maybe empty pure
+
+instance HasSqlValueSyntax be ByteString => HasSqlValueSyntax be FeedLocation where
+  sqlValueSyntax = sqlValueSyntax . toStrict . encode
+
+instance (BeamSqlBackend be, FromBackendRow be LByteString) => FromBackendRow be FeedItem where
+  fromBackendRow = fromBackendRow <&> decode >>= maybe empty pure
+
+instance HasSqlValueSyntax be ByteString => HasSqlValueSyntax be FeedItem where
+  sqlValueSyntax = sqlValueSyntax . toStrict . encode
+
+instance (BeamSqlBackend be, FromBackendRow be LByteString) => FromBackendRow be FeedDefinition where
+  fromBackendRow = fromBackendRow <&> decode >>= maybe empty pure
+
+instance HasSqlValueSyntax be ByteString => HasSqlValueSyntax be FeedDefinition where
+  sqlValueSyntax = sqlValueSyntax . toStrict . encode
+
+instance (BeamSqlBackend be, FromBackendRow be LByteString) => FromBackendRow be FeedStatus where
+  fromBackendRow = fromBackendRow <&> decode >>= maybe empty pure
+
+instance HasSqlValueSyntax be ByteString => HasSqlValueSyntax be FeedStatus where
+  sqlValueSyntax = sqlValueSyntax . toStrict . encode
+
+instance (BeamSqlBackend be, FromBackendRow be LByteString) => FromBackendRow be FeedItemStatus where
+  fromBackendRow = fromBackendRow <&> decode >>= maybe empty pure
+
+instance HasSqlValueSyntax be ByteString => HasSqlValueSyntax be FeedItemStatus where
+  sqlValueSyntax = sqlValueSyntax . toStrict . encode
diff --git a/src/main/HTTP.hs b/src/main/HTTP.hs
--- a/src/main/HTTP.hs
+++ b/src/main/HTTP.hs
@@ -1,27 +1,25 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications  #-}
--- | Implementation of "Imm.HTTP" based on "Network.HTTP.Client".
+{-# LANGUAGE TypeFamilies      #-}
+-- | Implementation of "Imm.HTTP" based on "Pipes.HTTP".
 module HTTP (mkHandle) where
 
 -- {{{ Imports
 import           Imm.HTTP
-import           Imm.Logger           hiding (Handle)
-import qualified Imm.Logger           as Logger
 import           Imm.Pretty
 
-import           Pipes.ByteString
-import           System.Process.Typed
+import           Network.HTTP.Types.Header
+import           Pipes.HTTP
 -- }}}
 
-mkHandle :: Logger.Handle IO -> Handle IO
-mkHandle logger = Handle $ \uri f ->
-  withProcessWait (httpie uri) $ \httpieProcess -> do
-    log logger Debug $ pretty $ show @String httpieProcess
-    f (fromHandle $ getStdout httpieProcess)
+headers :: [Header]
+headers = [(hUserAgent, "imm/1.0")]
 
-  where httpie uri = proc "http" ["--timeout", "10", "--follow", "--print", "b", "GET", show $ prettyURI uri]
-          & setStdin nullStream
-          & setStdout createPipe
-          & setStderr nullStream
+mkHandle :: m ~ IO => m (Handle m)
+mkHandle = do
+  manager <- newManager tlsManagerSettings
+
+  return $ Handle $ \uri f -> do
+    request <- parseUrlThrow $ show $ prettyURI uri
+    withHTTP request { requestHeaders = headers } manager f
diff --git a/src/main/Input.hs b/src/main/Input.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Input.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications   #-}
+module Input where
+
+-- {{{ Imports
+import           Imm.Feed
+import           Imm.Logger          as Logger
+import           Imm.Pretty
+import qualified Paths_imm           as Package
+
+import           Data.List
+import qualified Data.Set            as Set
+import           Data.Version
+import           Options.Applicative
+import           System.Directory
+import           System.FilePath
+import           System.Info
+import           URI.ByteString
+-- }}}
+
+-- * Types
+
+data ProgramInput = ProgramInput
+  { inputCommand          :: Command
+  , inputLogLevel         :: LogLevel
+  , inputReadOnlyDatabase :: Bool
+  , inputCallbacksFile    :: FilePath
+  } deriving(Eq, Ord, Show)
+
+instance Pretty ProgramInput where
+  pretty input = encloseSep "{ " " }" ", "
+    [ "command" <+> equals <+> pretty (inputCommand input)
+    , "log level" <+> equals <+> pretty (inputLogLevel input)
+    , "database read-only" <+> equals <+> pretty (inputReadOnlyDatabase input)
+    , "callbacks file" <+> equals <+> pretty (inputCallbacksFile input)
+    ]
+
+
+data Command = Subscribe FeedLocation (Set Text)
+             | Describe FeedQuery
+             | Reset FeedQuery
+             | Run FeedQuery CallbackMode
+             | Unsubscribe FeedQuery
+
+deriving instance Eq Command
+deriving instance Ord Command
+deriving instance Show Command
+
+instance Pretty Command where
+  pretty (Subscribe f _) = "Subscribe to feed:" <+> pretty f
+  pretty (Describe f)    = "Describe feed" <+> pretty f
+  pretty (Reset q)       = "Mark feeds as unprocessed:" <+> pretty q
+  pretty (Run q c)       = "Download new entries from:" <+> (if c == DisableCallbacks then space <> brackets "callbacks disabled" else mempty) <+> pretty q
+  pretty (Unsubscribe q) = "Unsubscribe from feeds:" <+> pretty q
+
+
+data CallbackMode = DisableCallbacks | EnableCallbacks
+  deriving(Eq, Ord, Read, Show)
+
+
+-- * Option parsers
+
+parseOptions :: (MonadIO m) => m ProgramInput
+parseOptions = io $ do
+  defaultCallbacksFile <- getXdgDirectory XdgConfig $ "imm" </> "callbacks.dhall"
+  customExecParser defaultPrefs $ info (allOptions defaultCallbacksFile <**> helper <**> versionPrinter) $ progDesc description
+
+description :: String
+description = "Execute arbitrary callbacks for each element of RSS/Atom feeds."
+
+allOptions :: FilePath -> Parser ProgramInput
+allOptions defaultCallbacksFile = ProgramInput
+  <$> commandParser
+  <*> (verboseFlag <|> quietFlag <|> logLevel <|> pure Info)
+  <*> readOnlyDatabase
+  <*> (callbacksFileOption <|> pure defaultCallbacksFile)
+
+commandParser :: Parser Command
+commandParser = hsubparser $ mconcat
+  [ command "subscribe" $ info subscribeCommand $ progDesc "Subscribe to a feed."
+  , command "add" $ info subscribeCommand $ progDesc "Alias for subscribe."
+
+  , command "run" $ info runCommand $ progDesc "Update list of feeds."
+  , command "describe" $ info describeCommand $ progDesc "Show details about given feed."
+  , command "show" $ info describeCommand $ progDesc "Alias for describe."
+  , command "list" $ info (pure $ Describe QueryAll) $ progDesc "Alias for describe --all ."
+  , command "reset" $ info resetCommand $ progDesc "Mark given feed as unprocessed."
+  , command "unsubscribe" $ info unsubscribeCommand $ progDesc "Unsubscribe from a feed."
+  , command "remove" $ info unsubscribeCommand $ progDesc "Alias for unsubscribe."
+  ]
+
+-- {{{ Commands
+describeCommand :: Parser Command
+describeCommand = Describe <$> feedQueryParser
+
+subscribeCommand :: Parser Command
+subscribeCommand    = Subscribe <$> feedLocationParser <*> (Set.fromList <$> many tagOption)
+
+unsubscribeCommand :: Parser Command
+unsubscribeCommand  = Unsubscribe <$> feedQueryParser
+
+runCommand :: Parser Command
+runCommand = Run
+  <$> feedQueryParser
+  <*> flag EnableCallbacks DisableCallbacks (long "no-callbacks" <> help "Disable callbacks.")
+
+resetCommand :: Parser Command
+resetCommand = Reset <$> feedQueryParser
+-- }}}
+
+-- {{{ Log options
+verboseFlag, quietFlag, logLevel :: Parser LogLevel
+verboseFlag = flag' Logger.Debug $ long "verbose" <> short 'v' <> help "Set log level to DEBUG."
+quietFlag   = flag' Logger.Error $ long "quiet" <> short 'q' <> help "Set log level to ERROR."
+logLevel    = option auto $ long "log-level" <> short 'l' <> metavar "LOG-LEVEL" <> value Info <> completeWith ["Debug", "Info", "Warning", "Error"] <> help "Set log level. Available values: Debug, Info, Warning, Error."
+-- }}}
+
+-- {{{ Other options
+readOnlyDatabase :: Parser Bool
+readOnlyDatabase = switch $ long "read-only" <> help "Disable database writes."
+
+tagOption :: Parser Text
+tagOption = option auto $ long "tag" <> short 't' <> metavar "TAG" <> help "Set the given tag."
+
+callbacksFileOption :: Parser FilePath
+callbacksFileOption = strOption $ long "callbacks" <> short 'c' <> metavar "FILE" <> help "Dhall configuration file for callbacks"
+-- }}}
+
+-- {{{ Util
+uriReader :: ReadM URI
+uriReader = eitherReader $ first show . parseURI laxURIParserOptions . encodeUtf8 @Text . fromString
+
+feedLocationParser :: Parser FeedLocation
+feedLocationParser = FeedLocation <$> argument uriReader (metavar "URI" <> help "URI to RSS/Atom document, or to HTML page.") <*> strOption (long "title" <> short 'T' <> value mempty <> help "Title used to disambiguate multiple alternate links in HTML page.")
+
+feedQueryParser :: Parser FeedQuery
+feedQueryParser = (QueryByUID <$> argument auto (metavar "TARGET")) <|> allFeeds where
+  allFeeds = flag' QueryAll $ short 'a' <> long "all" <> help "Run action on all subscribed feeds."
+
+uriArgument :: String -> Parser URI
+uriArgument helpText = argument uriReader $ metavar "URI" <> help helpText
+
+versionPrinter :: Parser (a -> a)
+versionPrinter = infoOption
+  (Data.List.unlines ["imm-" <> showVersion Package.version, "built with " <> compilerName <> "-" <> showVersion compilerVersion])
+  (long "version" <> short 'V' <> help "Print versions.")
+-- }}}
diff --git a/src/main/Logger.hs b/src/main/Logger.hs
--- a/src/main/Logger.hs
+++ b/src/main/Logger.hs
@@ -1,52 +1,59 @@
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
--- | Implementation of "Imm.Logger" based on @fast-logger@.
--- For further information, please consult "System.Log.FastLogger".
-module Logger (module Logger, module Reexport) where
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+-- | Implementation of "Imm.Logger" based on @co-log@.
+module Logger (withLogHandler, module Reexport) where
 
 -- {{{ Imports
 import           Imm.Logger                                as Reexport
 import           Imm.Pretty
 
+import           Chronos
+import           Colog                                     hiding (Severity (..))
+import qualified Colog                                     as Colog
 import           Data.Text.Prettyprint.Doc.Render.Terminal
-import           System.Log.FastLogger                     as Reexport
+import qualified Data.TypeRepMap                           as TypeRepMap
+import           System.Directory
+import           System.FilePath
 -- }}}
 
-data LoggerSettings = LoggerSettings
-  { _loggerSet      :: LoggerSet       -- ^ 'LoggerSet' used for 'Debug', 'Info' and 'Warning' logs
-  , _errorLoggerSet :: LoggerSet       -- ^ 'LoggerSet' used for 'Error' logs
-  , _logLevel       :: MVar LogLevel   -- ^ Discard logs that are strictly less serious than this level
-  , _colorizeLogs   :: MVar Bool       -- ^ Enable log colorisation
-  }
+mkHandle :: MonadIO m => MonadIO m' => LogAction m (RichMsg m' (Msg Colog.Severity)) -> IO (Handle m)
+mkHandle logAction = do
+  logLevel <- newTVarIO Debug
+  return $ Handle
+    (myLog logAction)
+    (readTVarIO logLevel)
+    (atomically . writeTVar logLevel)
 
 
--- | Default logger forwards error messages to stderr, and other messages to stdout.
-defaultLogger :: IO LoggerSettings
-defaultLogger = LoggerSettings
-  <$> newStdoutLoggerSet defaultBufSize
-  <*> newStderrLoggerSet defaultBufSize
-  <*> newMVar Info
-  <*> newMVar True
+myLog :: MonadIO m' => MonadIO m => LogAction m' (RichMsg m (Msg Colog.Severity)) -> LogLevel -> Doc AnsiStyle -> m' ()
+myLog logAction logLevel document = logAction <& RichMsg (Msg (level2severity logLevel) callStack message) defaultFieldMap where
+  level2severity Debug   = Colog.Debug
+  level2severity Info    = Colog.Info
+  level2severity Warning = Colog.Warning
+  level2severity Error   = Colog.Error
+  message = renderStrict $ layoutPretty defaultLayoutOptions document
 
 
-mkHandle :: MonadIO m => LoggerSettings -> Handle m
-mkHandle settings = Handle
-  { log = \l t -> do
-      refLevel <- readMVar $ _logLevel settings
-      handleColor <- do
-        keepColor <- readMVar (_colorizeLogs settings)
-        case (l, keepColor) of
-          (_, False) -> return unAnnotate
-          (Error, _) -> return red
-          (Warning, _) -> return yellow
-          _ -> return id
-      let loggerSet = (if l == Error then _errorLoggerSet else _loggerSet) settings
-      when (l >= refLevel) $ liftIO $ pushLogStrLn loggerSet $ toLogStr $ renderLazy $ layoutPretty defaultLayoutOptions $ handleColor t
+withLogHandler :: MonadIO m => (Handle m -> IO a) -> IO a
+withLogHandler f = do
+  logFile <- getXdgDirectory XdgConfig $ "imm" </> "imm.log"
+  withLogByteStringFile logFile $ \logFileAction ->
+    withBackgroundLogger defCapacity logFileAction $ \logAction ->
+      f =<< mkHandle (cmapM serializeMessage logAction)
+  where serializeMessage = fmap encodeUtf8 . formatMessage
 
-  , getLogLevel = readMVar $ _logLevel settings
-  , setLogLevel = void . swapMVar (_logLevel settings)
-  , setColorizeLogs = void . swapMVar (_colorizeLogs settings)
-  , flushLogs = liftIO $ do
-      flushLogStr $ _loggerSet settings
-      flushLogStr $ _errorLoggerSet settings
-  }
+formatMessage :: Monad m => RichMsg m (Msg Colog.Severity) -> m Text
+formatMessage (RichMsg (Msg severity stack text) fields) = do
+  posixTime <- extractField $ TypeRepMap.lookup @"posixTime" fields
+  threadId <- extractField $ TypeRepMap.lookup @"threadId" fields
+  return $ showSeverity severity
+    <> " " <> maybe mempty showTime posixTime
+    <> " " <> showSourceLoc stack
+    <> " " <> showThread threadId
+    <> " " <> text
+  where showTime posixTime = "[" <> encode_YmdHMS (SubsecondPrecisionFixed 0) hyphen (timeToDatetime posixTime)  <> "]"
+        showThread (Just tid) = "[" <> show tid <> "]"
+        showThread _ = mempty
diff --git a/src/main/Main.hs b/src/main/Main.hs
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -1,225 +1,200 @@
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 -- {{{ Imports
-import           Alternate
 import qualified Core
-import           Database
+import           Database.Async                as Database
+import           Database.Handle               as Database
+import           Database.ReadOnly             as Database
+import           Database.SQLite               as SQLite
 import           HTTP
+import           Input
 import           Logger
-import           Options
+import           Output                        (putDocLn)
+import qualified Output
 import           XML
 
-import           Control.Concurrent.Async
 import           Control.Concurrent.STM.TMChan
 import           Control.Exception.Safe
-import           Data.Conduit.Combinators      as Conduit (stdin)
-import           Dhall
+import           Dhall                         (auto, input)
 import           Imm
-import qualified Imm.Callback                  as Callback
-import           Imm.Database.Feed             as Database
-import qualified Imm.HTTP                      as HTTP
 import           Imm.Pretty
-import           Pipes.ByteString
-import           System.Exit
-import           System.Process.Typed
-import           URI.ByteString
+import           Pipes.ByteString              hiding (filter, stdout)
+import           Safe
+import           Streamly                      as Stream (async, asyncly, (|&))
+import qualified Streamly.Prelude              as Stream
 -- }}}
 
 
 main :: IO ()
 main = do
-  AllOptions{..} <- parseOptions
-  let GlobalOptions{..} = optionGlobal
+  programInput <- parseOptions
+  Output.withHandle $ \stdout -> do
+    withLogger programInput $ \logger -> do
+      handleAny (log logger Error . pretty . displayException) $ do
+        withDatabase logger stdout programInput $ \database -> do
+          case inputCommand programInput of
+            Subscribe u c     -> Core.subscribe logger stdout database u c
+            Unsubscribe query -> Core.unsubscribe logger database query
+            Describe query    -> Core.describeFeeds stdout database query
+            Reset query    -> Core.markAsUnprocessed logger database query
+            Run f c           -> main2 logger stdout database f =<< resolveCallbacks c (inputCallbacksFile programInput)
 
-  -- Setup logger
-  logger <- Logger.mkHandle <$> defaultLogger
-  setColorizeLogs logger optionColorizeLogs
-  setLogLevel logger optionLogLevel
-  log logger Debug $ "Options: " <> pretty optionCommand
+          Database.commit logger database
 
-  handleAny (log logger Error . pretty . displayException) $ do
-    -- Setup database
-    database <- Database.mkHandle <$> defaultDatabase
-    let database' = if optionReadOnlyDatabase then readOnly logger database else database
-    log logger Debug . ("Using database:" <++>) . indent 2 =<< _describeDatabase database'
 
-    case optionCommand of
-      Import            -> Core.importOPML logger database' Conduit.stdin
-      Subscribe u c     -> Core.subscribe logger database' u c
-      Unsubscribe query -> Core.unsubscribe logger database' query
-      List              -> Core.listFeeds logger database'
-      Describe query    -> Core.describeFeed logger database query
-      Reset feedKeys    -> Core.markAsUnprocessed logger database' feedKeys
-      Run f c           -> main2 logger database' f =<< resolveCallbacks c optionCallbacksFile
-
-    Database.commit logger database'
-
-  flushLogs logger
+withLogger :: ProgramInput -> (Logger.Handle IO -> IO ()) -> IO ()
+withLogger programInput f = withLogHandler $ \logger -> do
+  setLogLevel logger $ inputLogLevel programInput
+  log logger Info $ "Input:" <+> pretty programInput
+  f logger
 
+withDatabase :: m ~ IO => Logger.Handle m -> Output.Handle m -> ProgramInput -> (Database.Handle m -> m ()) -> m ()
+withDatabase logger stdout programInput f = do
+  database <- SQLite.mkHandle =<< SQLite.defaultDatabase
+  let database' = if inputReadOnlyDatabase programInput then readOnly logger database else database
+  log logger Info . ("Using database:" <++>) . indent 2 =<< _describeDatabase database'
+  Database.withAsyncHandle logger stdout database' f
 
 resolveCallbacks :: MonadIO m => CallbackMode -> FilePath -> m [Callback]
 resolveCallbacks EnableCallbacks callbacksFile = io $ input auto $ fromString callbacksFile
 resolveCallbacks _ _                           = return mempty
 
 
-main2 :: Logger.Handle IO -> Database.Handle IO -> FeedQuery -> [Callback] -> IO ()
-main2 logger database feedQuery callbacks = do
-  let httpClient = HTTP.mkHandle logger
+main2 :: Logger.Handle IO -> Output.Handle IO -> Database.Handle IO
+      -> FeedQuery -> [Callback] -> IO ()
+main2 logger stdout database feedQuery callbacks = do
+  newItemsCount <- newTVarIO (0 :: Int)
+  errorsCount <- newTVarIO (0 :: Int)
+  errorsChan <- newTMChanIO
 
-  feedLocations <- mapM (Database.resolveFeedLocation database)
-    =<< Database.resolveEntryKey database feedQuery
+  httpClient <- HTTP.mkHandle
 
-  feedLocationsChan <- newTMChanIO
-  targetFeedChan <- newTMChanIO
-  newItemsChan <- newTMChanIO
-  processedChan <- newTMChanIO
+  -- Feed record => (feed record, items)
+  let fetcher = catchErrors logger errorsChan errorsCount $ \feedRecord -> do
+        log logger Debug "Fetch worker starts"
 
-  resolveErrorsChan <- newTMChanIO
-  fetchErrorsChan <- newTMChanIO
-  runErrorsChan <- newTMChanIO
-  callbackErrorsChan <- newTMChanIO
+        let location@(FeedLocation uri _) = _feedLocation feedRecord
+        (feedDefinition, items) <- Core.downloadFeed logger httpClient (toLazyM >=> parseXml xmlParser uri) location
 
-  newItemsCount <- newTVarIO (0 :: Int)
-  errorsCount <- newTVarIO (0 :: Int)
+        newFeedStatus <- touchFeed $ _feedStatus feedRecord
 
-  -- => Feed IDs events
-  producer <- async $ forM_ feedLocations $ atomically . writeTMChan feedLocationsChan
+        let newFeedRecord = feedRecord { _feedDefinition = feedDefinition, _feedStatus = newFeedStatus }
+        _updateFeedDefinition database newFeedRecord
+        _updateFeedStatus database newFeedRecord
+        return $ Just (newFeedRecord, items)
 
-  -- Feed locations => feed direct URIs
-  let resolverF feedLocation = do
-        uri <- resolveFeedURI logger httpClient feedLocation
-        atomically $ writeTMChan targetFeedChan (feedLocation, uri)
+  -- (Feed record, items) => (feed record, items, item records)
+  let itemRetriever = catchErrors logger errorsChan errorsCount $ \(feedRecord, items) -> do
+        itemRecords <- _fetchItems database $ _feedKey feedRecord
+        return $ Just (feedRecord, items, itemRecords)
 
-  resolvers <- spawnConsumers logger 5 feedLocationsChan resolverF resolveErrorsChan errorsCount
+  -- (Feed record, items, item records) => multiple (feed record, item, item records)
+  let itemSplitter = \(feedRecord, items, itemRecords) ->
+        Stream.fromList [(feedRecord, item, itemRecords) | item <- items]
 
-  -- Feed direct URIs events => new item events
-  let fetcherF (feedLocation, uri) = do
-        feed <- HTTP.withGet logger httpClient uri
-          $ toLazyM >=> parseXml xmlParser uri
-        let entryKey = ByLocation feedLocation
+  let itemMatcher = \(feedRecord, item, itemRecords) -> do
+        let itemRecord = itemRecords & filter (\r -> _itemDefinition r `areSameItem` item) & headMay
+        return (feedRecord, item, itemRecord)
 
-        unreadElements <- filterM (fmap not . isRead database entryKey) $ getElements feed
-        unprocessedElements <- listUnprocessedElements database entryKey
-        forM_ (unprocessedElements <> unreadElements) $ \element -> do
-          log logger Info $ "New item:" <+> magenta (pretty entryKey) <+> "/" <+> yellow (pretty $ getTitle element)
-          atomically $ do
-            writeTMChan newItemsChan (entryKey, removeElements feed, element)
-            modifyTVar' newItemsCount (+ 1)
+  -- Filter for unread items
+  let unreadSelector (feedRecord, item, itemRecord) = checkDate || checkStatus where
+        checkDate = case (_feedLastUpdate $ _feedStatus feedRecord, _itemDate item) of
+          (Nothing, _)       -> True
+          (Just t0, Just t1) -> t0 < t1
+          _                  -> False
+        checkStatus = itemRecord <&> _itemStatus <&> (not . _isProcessed) & fromMaybe True
+        -- unprocessedElements <- listUnprocessedElements database entryKey
 
-  fetchers <- spawnConsumers logger 5 targetFeedChan fetcherF fetchErrorsChan errorsCount
+  let logNewItem (feedRecord, item, _) = putDocLn stdout $ "New item:"
+        <+> maybe "<unknown>" prettyTime (_itemDate item)
+        <+> magenta (prettyName $ _feedDefinition feedRecord)
+        <+> "/" <+> yellow (prettyName item)
 
   -- New items events => execute callback => processed/error events
-  let runnerF (entryKey, feed, element) = do
-        results <- forM callbacks $ \callback@(Callback executable arguments) -> do
-          let processInput = byteStringInput $ Callback.serializeMessage feed element
-              processConfig = proc executable (toString <$> arguments) & setStdin processInput
-
-          log logger Debug $ "Running" <+> cyan (pretty executable) <+> "on" <+> magenta (pretty entryKey) <+> "/" <+> yellow (pretty $ getTitle element)
-
-          (exitCode, output, errors) <- readProcess processConfig
-          case exitCode of
-            ExitSuccess   -> return $ Right callback
-            ExitFailure i -> return $ Left (callback, i, output, errors)
+  let runner = catchErrors logger errorsChan errorsCount $ \(feedRecord, item, itemRecord) -> do
+        results <- forM callbacks $ \callback -> io $ do
+          runCallback logger callback $ CallbackMessage (_feedDefinition feedRecord) item
 
         case lefts results of
-          [] -> atomically $ writeTMChan processedChan (entryKey, element)
-          e  -> atomically $ do
-            writeTMChan callbackErrorsChan ((entryKey, element), e)
-            modifyTVar' errorsCount (+ 1)
+          [] -> return $ Just (feedRecord, item, itemRecord)
+          e  -> do
+            io $ atomically $ do
+              writeTMChan errorsChan (toException $ CallbackException feedRecord item e)
+              modifyTVar' errorsCount (+ 1)
+            return Nothing
 
-  runners <- spawnConsumers logger 5 newItemsChan runnerF runErrorsChan errorsCount
+  let storer (_, _, Just itemRecord) =
+        Database.markItemAsProcessed logger database itemRecord
+      storer (feedRecord, item, _) = do
+        let itemRecord = mkFeedItemRecord (_feedKey feedRecord) item (FeedItemStatus True)
+        void $ Database.insertItem logger database itemRecord
 
-  -- Processed events => update database
-  storer <- async $ fix $ \recurse -> do
-    item <- atomically $ readTMChan processedChan
-    forM_ item $ \(feedID, element) -> do
-      log logger Debug $ "Updating database for" <+> pretty feedID <+> "/" <+> pretty (getTitle element)
-      Database.markAsProcessed logger database feedID element
-      recurse
 
-  -- Wait for all async processes to complete
-  wait producer
-  atomically $ closeTMChan feedLocationsChan
-
-  mapM_ wait resolvers
-  atomically $ do
-    closeTMChan targetFeedChan
-    closeTMChan resolveErrorsChan
-
-  mapM_ wait fetchers
-  atomically $ closeTMChan newItemsChan
+  entries <- case feedQuery of
+    QueryAll       -> Database._fetchAllFeeds database
+    QueryByUID uid -> pure <$> Database._fetchFeed database uid
 
-  mapM_ wait runners
-  atomically $ do
-    closeTMChan processedChan
-    closeTMChan fetchErrorsChan
-    closeTMChan callbackErrorsChan
-    closeTMChan runErrorsChan
+  Stream.fromList entries
+    |& Stream.mapMaybeM fetcher
+    |& Stream.mapMaybeM itemRetriever
+    |& Stream.concatMapWith async itemSplitter
+    |& Stream.mapM itemMatcher
+    |& Stream.filter unreadSelector
+    |& Stream.trace logNewItem
+    |& Stream.trace (const $ atomically $ modifyTVar' newItemsCount (+ 1))
+    |& Stream.mapMaybeM runner
+    |& Stream.mapM storer
+    & Stream.asyncly
+    & Stream.drain
 
-  wait storer
+  atomically $ closeTMChan errorsChan
 
   -- Error events => log
-  handleErrors resolveErrorsChan (printResolveError logger)
-  handleErrors fetchErrorsChan (printFetchError logger)
-  handleErrors callbackErrorsChan (printCallbackError logger)
-  handleErrors runErrorsChan (printRunError logger)
-  flushLogs logger
+  handleErrors stdout errorsChan
 
-  readTVarIO newItemsCount <&> pretty <&> bold <&> (<+> "new items") >>= log logger Info
-  readTVarIO errorsCount <&> pretty <&> bold <&> (<+> "errors") >>= log logger Info
+  readTVarIO newItemsCount <&> pretty <&> bold <&> (<+> "new items") >>= putDocLn stdout
+  readTVarIO errorsCount <&> pretty <&> bold <&> (<+> "errors") >>= putDocLn stdout
 
 
-spawnConsumers :: Logger.Handle IO -> Int -> TMChan i -> (i -> IO ()) -> TMChan (i, SomeException) -> TVar Int -> IO [Async ()]
-spawnConsumers logger n inputChan f errorsChan errorsCount =
-  replicateM n $ async $ fix $ \recurse -> do
-    maybeItem <- atomically $ readTMChan inputChan
-    forM_ maybeItem $ \item -> do
-      catchAny (f item) $ \e -> do
-        log logger Debug $ "Error:" <+> pretty (displayException e)
-        atomically $ do
-          writeTMChan errorsChan (item, e)
-          modifyTVar' errorsCount (+ 1)
-      recurse
+data CallbackException = CallbackException (FeedRecord Inserted) FeedItem [(Callback, Int, LByteString, LByteString)]
+  deriving(Eq, Generic, Ord, Show, Typeable)
 
-handleErrors :: MonadIO m => TMChan (input, error) -> ((input, error) -> m ()) -> m ()
-handleErrors errorsChan handler = fix $ \recurse -> do
-  items <- atomically $ readTMChan errorsChan
-  forM_ items $ \(i, e) -> handler (i, e) >> recurse
+instance Exception CallbackException where
+  displayException = show . pretty
 
-printResolveError :: Exception e => Logger.Handle m -> (FeedLocation, e) -> m ()
-printResolveError logger (feedLocation, e) = log logger Error $
-  bold ("Resolve error for" <+> pretty feedLocation)
-  <++> indent 2 (pretty $ displayException e)
+instance Pretty CallbackException where
+  pretty (CallbackException feedRecord item e) =
+    "Callback error for" <+> prettyName (_feedDefinition feedRecord) <+> "/" <+> prettyName item
+    <++> indent 2 prettyErrors
+    where prettyErrors = vsep $ do
+            (callback, i, stdout', stderr') <- e
+            return $ "When running:" <+> pretty callback
+              <++> "Exit code:" <+> pretty i
+              <++> "Stdout:" <++> indent 2 (pretty $ decodeUtf8 @Text stdout')
+              <++> "Stderr:" <++> indent 2 (pretty $ decodeUtf8 @Text stderr')
 
-printFetchError :: Exception e => Logger.Handle m -> ((FeedLocation, URIRef a), e) -> m ()
-printFetchError logger ((_, uri), e) = log logger Error $
-  bold ("Fetch error for" <+> prettyURI uri)
-  <++> indent 2 (pretty $ displayException e)
 
-printCallbackError :: i ~ (EntryKey, FeedElement)
-                   => e ~ (Callback, Int, LByteString, LByteString)
-                   => Logger.Handle m -> (i, [e]) -> m ()
-printCallbackError logger ((entryKey, element), e) = log logger Error $
-  bold ("Callback error for" <+> pretty entryKey <+> "/" <+> pretty (getTitle element))
-  <++> indent 2 prettyErrors
-  where prettyErrors = vsep $ do
-          (callback, i, stdout', stderr') <- e
-          return $ "When running:" <+> pretty callback
-            <++> "Exit code:" <+> pretty i
-            <++> "Stdout:" <++> indent 2 (pretty $ decodeUtf8 @Text stdout')
-            <++> "Stderr:" <++> indent 2 (pretty $ decodeUtf8 @Text stderr')
+catchErrors :: MonadIO m => MonadCatch m
+  => Logger.Handle m -> TMChan SomeException -> TVar Int -> (i -> m (Maybe a)) -> i -> m (Maybe a)
+catchErrors logger errorsChan errorsCount f input_ = catchAny (f input_) $ \e -> do
+  log logger Error $ pretty (displayException e)
+  io $ atomically $ do
+    writeTMChan errorsChan e
+    modifyTVar' errorsCount (+ 1)
+  return Nothing
 
-printRunError :: Exception e => Logger.Handle m -> ((EntryKey, Feed, FeedElement), e) -> m ()
-printRunError logger ((entryKey, _feed, element), e) = log logger Error $
-  bold ("Error for" <+> pretty entryKey <+> "/" <+> pretty (getTitle element))
-  <++> indent 2 (pretty $ displayException e)
+
+handleErrors :: MonadIO m => Output.Handle m -> TMChan SomeException -> m ()
+handleErrors stdout errorsChan = fix $ \recurse -> do
+  items <- atomically $ readTMChan errorsChan
+  forM_ items $ \e -> putDocLn stdout (red $ pretty $ displayException e) >> recurse
 
 
 xmlParser :: XML.Handle IO
diff --git a/src/main/Options.hs b/src/main/Options.hs
deleted file mode 100644
--- a/src/main/Options.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications   #-}
-module Options where
-
--- {{{ Imports
-import           Imm.Feed
-import           Imm.Logger          as Logger
-import           Imm.Pretty
-import qualified Paths_imm           as Package
-
-import           Data.List
-import qualified Data.Set            as Set
-import           Data.Version
-import           Options.Applicative
-import           System.Directory
-import           System.FilePath
-import           System.Info
-import           URI.ByteString
--- }}}
-
--- * Types
-
-data AllOptions = AllOptions
-  { optionCommand :: Command
-  , optionGlobal  :: GlobalOptions
-  } deriving(Eq, Show)
-
-
-data GlobalOptions = GlobalOptions
-  { optionLogLevel         :: LogLevel
-  , optionColorizeLogs     :: Bool
-  , optionReadOnlyDatabase :: Bool
-  , optionCallbacksFile    :: FilePath
-  } deriving(Eq, Ord, Read, Show)
-
-
-data Command = Import
-             | Subscribe FeedLocation (Set Text)
-             | List
-             | Describe FeedQuery
-             | Reset FeedQuery
-             | Run FeedQuery CallbackMode
-             | Unsubscribe FeedQuery
-
-deriving instance Eq Command
-deriving instance Ord Command
-deriving instance Show Command
-
-instance Pretty Command where
-  pretty Import          = "Import feeds"
-  pretty (Subscribe f _) = "Subscribe to feed:" <+> pretty f
-  pretty List            = "List all feeds"
-  pretty (Describe f)    = "Describe feed" <+> pretty f
-  pretty (Reset q)       = "Mark feeds as unprocessed:" <+> pretty q
-  pretty (Run q c)       = "Download new entries from feeds" <> (if c == DisableCallbacks then space <> brackets "callbacks disabled" else mempty) <+> pretty q
-  pretty (Unsubscribe q) = "Unsubscribe from feeds:" <+> pretty q
-
-
-data CallbackMode = DisableCallbacks | EnableCallbacks
-  deriving(Eq, Ord, Read, Show)
-
-
--- * Option parsers
-
-parseOptions :: (MonadIO m) => m AllOptions
-parseOptions = io $ do
-  defaultCallbacksFile <- getXdgDirectory XdgConfig $ "imm" </> "callbacks.dhall"
-  customExecParser defaultPrefs $ info (allOptions defaultCallbacksFile <**> helper <**> versionPrinter) $ progDesc description
-
-description :: String
-description = "Execute arbitrary callbacks for each element of RSS/Atom feeds."
-
-allOptions :: FilePath -> Parser AllOptions
-allOptions defaultCallbacksFile = AllOptions
-  <$> commandParser
-  <*> globalOptions defaultCallbacksFile
-
-globalOptions :: FilePath -> Parser GlobalOptions
-globalOptions defaultCallbacksFile = GlobalOptions
-  <$> (verboseFlag <|> quietFlag <|> logLevel <|> pure Info)
-  <*> colorizeLogs
-  <*> readOnlyDatabase
-  <*> (callbacksFileOption <|> pure defaultCallbacksFile)
-
-commandParser :: Parser Command
-commandParser = hsubparser $ mconcat
-  [ command "import" $ info (pure Import) $ progDesc "Import feeds list from an OPML descriptor (read from stdin)."
-  , command "subscribe" $ info subscribeCommand $ progDesc "Subscribe to a feed."
-  , command "add" $ info subscribeCommand $ progDesc "Alias for subscribe."
-
-  , command "run" $ info runCommand $ progDesc "Update list of feeds."
-  , command "describe" $ info describeCommand $ progDesc "Show details about given feed."
-  , command "show" $ info describeCommand $ progDesc "Alias for describe."
-  , command "list" $ info (pure List) $ progDesc "List all feed sources currently configured, along with their status."
-  , command "reset" $ info resetCommand $ progDesc "Mark given feed as unprocessed."
-  , command "unsubscribe" $ info unsubscribeCommand $ progDesc "Unsubscribe from a feed."
-  , command "remove" $ info unsubscribeCommand $ progDesc "Alias for unsubscribe."
-  ]
-
--- {{{ Commands
-describeCommand :: Parser Command
-describeCommand = Describe <$> feedQueryParser
-
-subscribeCommand :: Parser Command
-subscribeCommand    = Subscribe <$> feedLocationParser <*> (Set.fromList <$> many tagOption)
-
-unsubscribeCommand :: Parser Command
-unsubscribeCommand  = Unsubscribe <$> feedQueryParser
-
-runCommand :: Parser Command
-runCommand = Run
-  <$> feedQueryParser
-  <*> flag EnableCallbacks DisableCallbacks (long "no-callbacks" <> help "Disable callbacks.")
-
-resetCommand :: Parser Command
-resetCommand = Reset <$> feedQueryParser
--- }}}
-
--- {{{ Log options
-verboseFlag, quietFlag, logLevel :: Parser LogLevel
-verboseFlag = flag' Logger.Debug $ long "verbose" <> short 'v' <> help "Set log level to DEBUG."
-quietFlag   = flag' Logger.Error $ long "quiet" <> short 'q' <> help "Set log level to ERROR."
-logLevel    = option auto $ long "log-level" <> short 'l' <> metavar "LOG-LEVEL" <> value Info <> completeWith ["Debug", "Info", "Warning", "Error"] <> help "Set log level. Available values: Debug, Info, Warning, Error."
-
-colorizeLogs :: Parser Bool
-colorizeLogs = flag True False $ long "nocolor" <> help "Disable log colorisation."
--- }}}
-
--- {{{ Other options
-readOnlyDatabase :: Parser Bool
-readOnlyDatabase = switch $ long "read-only" <> help "Disable database writes."
-
-tagOption :: Parser Text
-tagOption = option auto $ long "tag" <> short 't' <> metavar "TAG" <> help "Set the given tag."
-
-callbacksFileOption :: Parser FilePath
-callbacksFileOption = strOption $ long "callbacks" <> short 'c' <> metavar "FILE" <> help "Dhall configuration file for callbacks"
--- }}}
-
--- {{{ Util
-uriReader :: ReadM URI
-uriReader = eitherReader $ first show . parseURI laxURIParserOptions . encodeUtf8 @Text . fromString
-
-feedLocationParser :: Parser FeedLocation
-feedLocationParser = byUri <|> byAlternateLink where
-  byUri = FeedDirectURI <$> option uriReader (long "uri" <> short 'u' <> metavar "URI" <> help "URI to feed")
-  byAlternateLink = FeedAlternateLink
-    <$> option uriReader (long "alternate" <> short 'a' <> metavar "URI" <> help "URI to webpage with alternate link")
-    <*> (strOption (long "title" <> short 't' <> help "Alternate link title") <|> pure mempty)
-
-feedQueryParser :: Parser FeedQuery
-feedQueryParser = argument parser (metavar "TARGET") <|> allFeeds where
-  parser = (ByDatabaseID <$> auto) <|> (ByURI <$> uriReader)
-  allFeeds = flag' AllFeeds $ short 'a' <> long "all" <> help "Run action on all subscribed feeds."
-
-uriArgument :: String -> Parser URI
-uriArgument helpText = argument uriReader $ metavar "URI" <> help helpText
-
-versionPrinter :: Parser (a -> a)
-versionPrinter = infoOption
-  (Data.List.unlines ["imm-" <> showVersion Package.version, "built with " <> compilerName <> "-" <> showVersion compilerVersion])
-  (long "version" <> short 'V' <> help "Print versions.")
--- }}}
diff --git a/src/main/Output.hs b/src/main/Output.hs
new file mode 100644
--- /dev/null
+++ b/src/main/Output.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Output where
+
+import           Control.Concurrent.Async
+import           Control.Concurrent.STM.TMChan
+import           Data.Text.Prettyprint.Doc.Render.Terminal
+import           Imm.Pretty
+
+-- * Types
+
+-- | Handle to push messages to the program's output
+newtype Handle m = Handle
+  { putDocLn :: Doc AnsiStyle -> m ()
+  }
+
+withHandle :: (Handle IO -> IO ()) -> IO ()
+withHandle f = do
+  channel <- newTMChanIO
+
+  thread <- async $ fix $ \recurse -> do
+    maybeMessage <- atomically $ readTMChan channel
+    forM_ maybeMessage $ \message -> do
+      putLTextLn $ renderLazy $ layoutPretty defaultLayoutOptions message
+      recurse
+
+  f $ Handle { putDocLn = atomically . writeTMChan channel }
+  atomically (closeTMChan channel) >> wait thread
diff --git a/src/main/Prelude.hs b/src/main/Prelude.hs
--- a/src/main/Prelude.hs
+++ b/src/main/Prelude.hs
@@ -1,7 +1,19 @@
-module Prelude (io, module Relude, module Relude.Extra.Map) where
+module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where
 
-import           Relude           hiding (Handle, appendFile, force, readFile, writeFile)
+import           Relude           hiding (Handle, appendFile, force, readFile, stdout, writeFile)
 import           Relude.Extra.Map (lookup)
+import           Control.Exception.Safe
 
 io :: MonadIO m => IO a -> m a
 io = liftIO
+
+for :: [a] -> (a -> b) -> [b]
+for = flip map
+
+headThrow :: MonadThrow m => Exception e => e -> [a] -> m a
+headThrow _ (a:_) = return a
+headThrow e _ = throwM e
+
+headFail :: MonadFail m => String -> [a] -> m a
+headFail _ (a:_) = return a
+headFail e _ = fail e
diff --git a/src/main/XML.hs b/src/main/XML.hs
--- a/src/main/XML.hs
+++ b/src/main/XML.hs
@@ -10,10 +10,7 @@
 import           Control.Exception.Safe
 import           Data.Conduit
 import           Data.XML.Types
-import           Text.Atom.Conduit.Parse
-import           Text.RSS.Conduit.Parse
-import           Text.RSS1.Conduit.Parse
-import           Text.XML.Stream.Parse   as XML
+import           Text.XML.Stream.Parse  as XML
 import           URI.ByteString
 -- }}}
 
@@ -24,7 +21,9 @@
 -- | 'Conduit' based implementation
 mkHandle :: MonadIO m => MonadCatch m => XmlParser -> Handle m
 mkHandle (XmlParser preProcess) = Handle
-  { parseXml = \uri bytestring -> liftIO $ runConduit $ parseLBS def bytestring .| preProcess uri .| XML.force "Invalid feed" ((fmap Atom <$> atomFeed) `orE` (fmap Rss <$> rssDocument) `orE` (fmap Rss <$> rss1Document))
+  { parseXml = \uri bytestring -> liftIO $ runConduit $ parseLBS def bytestring
+      .| preProcess uri
+      .| XML.force "Invalid feed" feedC
   }
 
 -- | Forward all 'Event's without any pre-process
diff --git a/src/send-mail/Main.hs b/src/send-mail/Main.hs
--- a/src/send-mail/Main.hs
+++ b/src/send-mail/Main.hs
@@ -3,23 +3,23 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | 'Callback' for @imm@ that sends a mail via a SMTP server the input RSS/Atom item.
 -- {{{ Imports
-import qualified Imm.Callback         as Callback
+import           Imm.Callback            (CallbackMessage (..))
 import           Imm.Feed
+import           Imm.Link
 import           Imm.Pretty
 
-import           Data.ByteString.Lazy (getContents)
-import           Data.Text            as Text (intercalate)
+import           Data.Aeson
+import           Data.ByteString.Lazy    (getContents)
+import           Data.Text               as Text (intercalate)
 import           Data.Time
-import           Dhall                hiding (map, maybe)
-import           Network.Mail.Mime    hiding (sendmail)
-import           Options.Applicative  hiding (auto)
-import           Refined
-import           System.Directory     (XdgDirectory (..), getXdgDirectory)
-import           System.Exit          (ExitCode (..))
+import           Dhall                   hiding (map, maybe)
+import           Network.Mail.Mime       hiding (sendmail)
+import           Options.Applicative     hiding (auto)
+import           System.Directory        (XdgDirectory (..), getXdgDirectory)
+import           System.Exit             (ExitCode (..))
 import           System.FilePath
 import           System.Process.Typed
-import           Text.Atom.Types
-import           Text.RSS.Types
+import           URI.ByteString.Extended
 -- }}}
 
 -- | How to call external command
@@ -32,10 +32,10 @@
 
 -- | How to format outgoing mails from feed elements
 data FormatMail = FormatMail
-  { formatFrom    :: Feed -> FeedElement -> Address    -- ^ How to write the From: header of feed mails
-  , formatSubject :: Feed -> FeedElement -> Text       -- ^ How to write the Subject: header of feed mails
-  , formatBody    :: Feed -> FeedElement -> Text       -- ^ How to write the body of feed mails (sic!)
-  , formatTo      :: Feed -> FeedElement -> [Address]  -- ^ How to write the To: header of feed mails
+  { formatFrom    :: FeedDefinition -> FeedItem -> Address    -- ^ How to write the From: header of feed mails
+  , formatSubject :: FeedDefinition -> FeedItem -> Text       -- ^ How to write the Subject: header of feed mails
+  , formatBody    :: FeedDefinition -> FeedItem -> Text       -- ^ How to write the body of feed mails (sic!)
+  , formatTo      :: FeedDefinition -> FeedItem -> [Address]  -- ^ How to write the To: header of feed mails
   }
 
 data CliOptions = CliOptions
@@ -70,9 +70,9 @@
   CliOptions configFile recipients dryRun <- parseOptions
   Command executable arguments <- input auto $ fromString configFile
 
-  message <- getContents <&> Callback.deserializeMessage
+  message <- getContents <&> eitherDecode
   case message of
-    Right (feed, element) -> do
+    Right (CallbackMessage feed element) -> do
       timezone <- io getCurrentTimeZone
       currentTime <- io getCurrentTime
       let formatMail = FormatMail defaultFormatFrom defaultFormatSubject defaultFormatBody (const $ const recipients)
@@ -97,35 +97,31 @@
 -- | Fill 'addressName' with the feed title and, if available, the authors' names.
 --
 -- This function leaves 'addressEmail' empty. You are expected to fill it adequately, because many SMTP servers enforce constraints on the From: email.
-defaultFormatFrom :: Feed -> FeedElement -> Address
-defaultFormatFrom (Rss doc) (RssElement item) = Address (Just $ channelTitle doc <> " (" <> itemAuthor item <> ")") ""
-defaultFormatFrom (Atom feed) (AtomElement entry) = Address (Just $ title <> " (" <> authors <> ")") ""
-  where title = show . prettyAtomText $ feedTitle feed
-        authors = Text.intercalate ", " $ map (unrefine . personName) $ entryAuthors entry <> feedAuthors feed
-defaultFormatFrom _ _ = Address (Just "Unknown") ""
+defaultFormatFrom :: FeedDefinition -> FeedItem -> Address
+defaultFormatFrom feed item = Address (Just $ title <> " (" <> authors <> ")") ""
+  where title = _feedTitle feed
+        authors = Text.intercalate ", " $ map _authorName $ _itemAuthors item
 
 -- | Fill mail subject with the element title
-defaultFormatSubject :: Feed -> FeedElement -> Text
-defaultFormatSubject _ = getTitle
+defaultFormatSubject :: FeedDefinition -> FeedItem -> Text
+defaultFormatSubject _ = _itemTitle
 
 -- | Fill mail body with:
 --
 -- - a list of links associated to the element
 -- - the element's content or description/summary
-defaultFormatBody :: Feed -> FeedElement -> Text
-defaultFormatBody _ (RssElement item) = "<p>" <> maybe "<no link>" (withRssURI (show . prettyURI)) (itemLink item) <> "</p><p>" <> itemDescription item <> "</p>"
-defaultFormatBody _ (AtomElement entry) = "<p>" <> Text.intercalate "<br/>" links <> "</p><p>" <> fromMaybe "<empty>" (content <|> summary) <> "</p>"
-  where links   = map (withAtomURI (show . prettyURI) . linkHref) $ entryLinks entry
-        content = show . prettyAtomContent <$> entryContent entry
-        summary = show . prettyAtomText <$> entrySummary entry
+defaultFormatBody :: FeedDefinition -> FeedItem -> Text
+defaultFormatBody _ item = "<p>" <> Text.intercalate "<br/>" links <> "</p><p>" <> content <> "</p>"
+  where links   = map (withAnyURI (show . prettyURI) . _linkURI) $ _itemLinks item
+        content = _itemContent item
 
 
 -- * Low-level helpers
 
 -- | Build mail from a given feed
-buildMail :: FormatMail -> UTCTime -> TimeZone -> Feed -> FeedElement -> Mail
+buildMail :: FormatMail -> UTCTime -> TimeZone -> FeedDefinition -> FeedItem -> Mail
 buildMail format currentTime timeZone feed element =
-  let date = formatTime defaultTimeLocale "%a, %e %b %Y %T %z" $ utcToZonedTime timeZone $ fromMaybe currentTime $ getDate element
+  let date = formatTime defaultTimeLocale "%a, %e %b %Y %T %z" $ utcToZonedTime timeZone $ fromMaybe currentTime $ _itemDate element
   in Mail
     { mailFrom = formatFrom format feed element
     , mailTo   = formatTo format feed element
diff --git a/src/send-mail/Prelude.hs b/src/send-mail/Prelude.hs
--- a/src/send-mail/Prelude.hs
+++ b/src/send-mail/Prelude.hs
@@ -1,7 +1,19 @@
-module Prelude (io, module Relude, module Relude.Extra.Map) where
+module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where
 
-import           Relude           hiding (Handle, appendFile, force, readFile, writeFile)
+import           Relude           hiding (Handle, appendFile, force, readFile, stdout, writeFile)
 import           Relude.Extra.Map (lookup)
+import           Control.Exception.Safe
 
 io :: MonadIO m => IO a -> m a
 io = liftIO
+
+for :: [a] -> (a -> b) -> [b]
+for = flip map
+
+headThrow :: MonadThrow m => Exception e => e -> [a] -> m a
+headThrow _ (a:_) = return a
+headThrow e _ = throwM e
+
+headFail :: MonadFail m => String -> [a] -> m a
+headFail _ (a:_) = return a
+headFail e _ = fail e
diff --git a/src/write-file/Main.hs b/src/write-file/Main.hs
--- a/src/write-file/Main.hs
+++ b/src/write-file/Main.hs
@@ -4,24 +4,24 @@
 --
 -- Meant to be use as a callback for imm.
 -- {{{ Imports
-import           Imm.Callback                  as Callback
+import           Imm.Callback
 import           Imm.Feed
+import           Imm.Link
 import           Imm.Pretty
 
+import           Data.Aeson
 import           Data.ByteString.Builder
 import           Data.ByteString.Lazy          (getContents, writeFile)
-import qualified Data.Text                     as Text (null, replace)
+import qualified Data.Text                     as Text (replace)
 import           Data.Time
 import           Options.Applicative
 import           System.Directory              (createDirectoryIfMissing)
 import           System.FilePath
-import           Text.Atom.Types
 import           Text.Blaze.Html.Renderer.Utf8
 import           Text.Blaze.Html5              (Html, docTypeHtml, preEscapedToHtml, (!))
 import qualified Text.Blaze.Html5              as H
 import qualified Text.Blaze.Html5.Attributes   as H (charset, href)
-import           Text.RSS.Types
-import           URI.ByteString
+import           URI.ByteString.Extended
 -- }}}
 
 data CliOptions = CliOptions
@@ -42,12 +42,12 @@
 main :: IO ()
 main = do
   CliOptions directory dryRun <- parseOptions
-  input <- getContents <&> Callback.deserializeMessage
+  input <- getContents <&> eitherDecode
 
-  case input :: Either String (Feed, FeedElement) of
-    Right (feed, element) -> do
-      let content = defaultFileContent feed element
-          filePath = defaultFilePath directory feed element
+  case input :: Either String CallbackMessage of
+    Right (CallbackMessage feedDefinition item) -> do
+      let content = defaultFileContent feedDefinition item
+          filePath = defaultFilePath directory feedDefinition item
       putStrLn filePath
       unless dryRun $ do
         createDirectoryIfMissing True $ takeDirectory filePath
@@ -58,11 +58,11 @@
 -- * Default behavior
 
 -- | Generate a path @<root>/<feed title>/<element date>-<element title>.html@, where @<root>@ is the first argument
-defaultFilePath :: FilePath -> Feed -> FeedElement -> FilePath
-defaultFilePath root feed element = makeValid $ root </> toString title </> fileName <.> "html" where
-  date = maybe "" (formatTime defaultTimeLocale "%F-") $ getDate element
-  fileName = date <> toString (sanitize $ getTitle element)
-  title = sanitize $ getFeedTitle feed
+defaultFilePath :: FilePath -> FeedDefinition -> FeedItem -> FilePath
+defaultFilePath root feedDefinition element = makeValid $ root </> toString title </> fileName <.> "html" where
+  date = maybe "" (formatTime defaultTimeLocale "%F-") $ _itemDate element
+  fileName = date <> toString (sanitize $ _itemTitle element)
+  title = sanitize $ _feedTitle feedDefinition
   sanitize = appEndo (mconcat [Endo $ Text.replace (toText [s]) "_" | s <- pathSeparators])
     >>> Text.replace "." "_"
     >>> Text.replace "?" "_"
@@ -70,59 +70,53 @@
     >>> Text.replace "#" "_"
 
 -- | Generate an HTML page, with a title, a header and an article that contains the feed element
-defaultFileContent :: Feed -> FeedElement -> Builder
-defaultFileContent feed element = renderHtmlBuilder $ docTypeHtml $ do
+defaultFileContent :: FeedDefinition -> FeedItem -> Builder
+defaultFileContent feedDefinition element = renderHtmlBuilder $ docTypeHtml $ do
   H.head $ do
     H.meta ! H.charset "utf-8"
-    H.title $ convertText $ getFeedTitle feed <> " | " <> getTitle element
+    H.title $ convertText $ _feedTitle feedDefinition <> " | " <> _itemTitle element
   H.body $ do
-    H.h1 $ convertText $ getFeedTitle feed
+    H.h1 $ convertText $ _feedTitle feedDefinition
     H.article $ do
       H.header $ do
-        defaultArticleTitle feed element
-        defaultArticleAuthor feed element
-        defaultArticleDate feed element
-      defaultBody feed element
+        defaultArticleTitle feedDefinition element
+        defaultArticleAuthor feedDefinition element
+        defaultArticleDate feedDefinition element
+      defaultBody feedDefinition element
 
 
 -- * Low-level helpers
 
-defaultArticleTitle :: Feed -> FeedElement -> Html
-defaultArticleTitle _ element@(RssElement item) = H.h2 $ maybe id (\uri -> H.a ! H.href uri) link $ convertText $ getTitle element where
-  link = withRssURI (convertDoc . prettyURI) <$> itemLink item
-defaultArticleTitle _ element@(AtomElement _) = H.h2 $ convertText $ getTitle element
+defaultArticleTitle :: FeedDefinition -> FeedItem -> Html
+defaultArticleTitle _ item = H.h2
+  $ maybe id (\link -> H.a ! href (_linkURI link)) (getMainLink item)
+  $ convertText $ _itemTitle item
 
-defaultArticleAuthor :: Feed -> FeedElement -> Html
-defaultArticleAuthor _ (RssElement item) = unless (Text.null author) $ H.address $ "Published by " >> convertText author where
-  author = itemAuthor item
-defaultArticleAuthor _ (AtomElement entry) = H.address $ do
+defaultArticleAuthor :: FeedDefinition -> FeedItem -> Html
+defaultArticleAuthor _ item = H.address $ do
   "Published by "
-  forM_ (entryAuthors entry) $ \author -> do
-    convertDoc $ prettyPerson author
+  forM_ (_itemAuthors item) $ \author -> do
+    convertDoc $ pretty author
     ", "
 
-defaultArticleDate :: Feed -> FeedElement -> Html
-defaultArticleDate _ element = forM_ (getDate element) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date)
+defaultArticleDate :: FeedDefinition -> FeedItem -> Html
+defaultArticleDate _ element = forM_ (_itemDate element) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date)
 
 
 -- | Generate the HTML content for a given feed element
-defaultBody :: Feed -> FeedElement -> Html
-defaultBody _ element@(RssElement _) = H.p $ preEscapedToHtml $ getContent element
-defaultBody _ element@(AtomElement entry) = do
+defaultBody :: FeedDefinition -> FeedItem -> Html
+defaultBody _ item = do
   unless (null links) $ H.p $ do
     "Related links:"
-    H.ul $ forM_ links $ \uri -> H.li (H.a ! withAtomURI href uri $ convertAtomURI uri)
-  H.p $ preEscapedToHtml $ getContent element
-  where links   = map linkHref $ entryLinks entry
+    H.ul $ forM_ links $ \uri -> H.li (H.a ! href uri $ convertURI uri)
+  H.p $ preEscapedToHtml $ _itemContent item
+  where links   = _linkURI <$> _itemLinks item
 
-href :: URIRef a -> H.Attribute
+href :: AnyURI -> H.Attribute
 href = H.href . convertURI
 
-convertAtomURI :: (IsString t) => AtomURI -> t
-convertAtomURI = withAtomURI convertURI
-
-convertURI :: (IsString t) => URIRef a -> t
-convertURI = convertText . decodeUtf8 . serializeURIRef'
+convertURI :: (IsString t) => AnyURI -> t
+convertURI = convertText . decodeUtf8 . withAnyURI serializeURIRef'
 
 convertText :: (IsString t) => Text -> t
 convertText = fromString . toString
diff --git a/src/write-file/Prelude.hs b/src/write-file/Prelude.hs
--- a/src/write-file/Prelude.hs
+++ b/src/write-file/Prelude.hs
@@ -1,7 +1,19 @@
-module Prelude (io, module Relude, module Relude.Extra.Map) where
+module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where
 
-import           Relude           hiding (Handle, appendFile, force, readFile, writeFile)
+import           Relude           hiding (Handle, appendFile, force, readFile, stdout, writeFile)
 import           Relude.Extra.Map (lookup)
+import           Control.Exception.Safe
 
 io :: MonadIO m => IO a -> m a
 io = liftIO
+
+for :: [a] -> (a -> b) -> [b]
+for = flip map
+
+headThrow :: MonadThrow m => Exception e => e -> [a] -> m a
+headThrow _ (a:_) = return a
+headThrow e _ = throwM e
+
+headFail :: MonadFail m => String -> [a] -> m a
+headFail _ (a:_) = return a
+headFail e _ = fail e