Merge ../logfeed

apps/logfeed/.gitignore

@@ -0,0 +1,3 @@
+/dist-newstyle
+/result
+.direnv

apps/logfeed/Mail.hs

@@ -0,0 +1,220 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+import           Prelude                        ( )
+import           Relude
+import qualified Notmuch
+import           Say
+import           Data.String.Interpolate
+import qualified Data.MIME                     as MIME
+import           Data.MIME.Charset
+import           Control.Lens            hiding ( argument )
+import           Control.Error                  ( withExceptT
+                                                , throwE
+                                                , tryJust, tryRight
+                                                )
+import qualified Data.Text                     as T
+import           Control.Monad.Catch            ( MonadCatch
+                                                , handleIOError
+                                                )
+import           Data.Time
+import           Relude.Extra.Group
+import qualified Data.Map                      as Map
+import qualified Options.Applicative           as O
+import           Text.Atom.Feed.Export          ( textFeed )
+import           Text.Atom.Feed
+import           Text.HTML.TagSoup
+import Data.Either.Extra (mapLeft)
+
+data Options = Options
+  { dbPath :: String
+  , folder :: String
+  }
+
+data Thread = Thread
+  { subject    :: Text
+  , threadid   :: ByteString
+  , authors    :: [Text]
+  , date       :: UTCTime
+  , totalCount :: Int
+  , messages   :: [Message]
+  }
+type Error = Text
+
+data Body = HTMLBody Text | TextBody Text
+
+data Message = Message
+  { date    :: UTCTime
+  , headers :: [(Text, Text)]
+  , body    :: Body
+  }
+
+main :: IO ()
+main = do
+  Options { dbPath, folder } <- O.execParser $ O.info
+    (    Options
+    <$>  O.argument
+           O.str
+           (  O.metavar "DBPATH"
+           <> O.help "The full path to the notmuch database"
+           )
+    <*>  O.argument
+           O.str
+           (O.metavar "FOLDER" <> O.help "The maildir to scan for messages.")
+    <**> O.helper
+    )
+    O.fullDesc
+  res <- runExceptT do
+    (thrds, msgs) <- withExceptT
+      (\(er :: Notmuch.Status) ->
+        [i|Failed to read notmuch data.\ndb path: #{dbPath}\nquery: Folder #{folder}\nerror: #{er}|]
+      )
+      do
+        db <- Notmuch.databaseOpenReadOnly dbPath
+        q  <- Notmuch.query db (Notmuch.Folder folder)
+        (,) <$> Notmuch.threads q <*> Notmuch.messages q
+    msgsByThread  <- forM msgs \msg -> Notmuch.threadId msg <&> (, Right msg)
+    thrdsByThread <- forM thrds \thrd -> Notmuch.threadId thrd <&> (, Left thrd)
+    result        <-
+      mapM (runExceptT . processThread) . Map.toList $ fmap snd <$> groupBy
+        fst
+        (msgsByThread <> thrdsByThread)
+    now <- lift getCurrentTime
+    let entries =
+          threadToEntry <$> sortOn (date :: Thread -> UTCTime) (rights result)
+        feed = nullFeed [i|read-later-e-mails-#{timestamp now}|]
+                        (TextString "Readlater-E-Mail")
+                        (timestamp now)
+        errors = lefts result
+    feedText <- tryJust [i|Failed to generate feed.|] . textFeed $ feed
+      { feedEntries = (if null errors then id else (errorsToEntry now errors :))
+                        entries
+      }
+    say $ toStrict feedText
+  either
+    (\(er :: Text) ->
+      sayErr [i|mail2feed failed to export mails to rss.\n#{er}|]
+    )
+    (const pass)
+    res
+
+threadToEntry :: Thread -> Entry
+threadToEntry Thread { subject, messages, threadid, totalCount, date, authors }
+  = (nullEntry threadUrl threadTitle (timestamp date))
+    { entryContent = Just . HTMLContent $ content
+    , entryAuthors = (\x -> nullPerson { personName = x }) <$> authors
+    }
+ where
+  threadUrl   = [i|thread-#{threadid}-#{timestamp date}|]
+  threadTitle = TextString [i|#{subject} (#{length messages}/#{totalCount})|]
+  content     = T.intercalate [i|<br>\n<hr>\n|] (messageToHtml <$> messages)
+
+errorsToEntry :: UTCTime -> [Error] -> Entry
+errorsToEntry now er = (nullEntry [i|mailerrors - #{timestamp now}|]
+                                  (TextString [i|Mail processing Errors|])
+                                  (timestamp now)
+                       )
+  { entryContent = Just
+                   . HTMLContent
+                   . T.intercalate "<br>\n"
+                   . T.splitOn "\n"
+                   . T.intercalate "\n"
+                   $ er
+  }
+
+timestamp :: UTCTime -> Text
+timestamp = toText . formatTime defaultTimeLocale "%Y-%m-%d %H:%M"
+
+processThread
+  :: (MonadIO m, MonadCatch m)
+  => ( Notmuch.ThreadId
+     , NonEmpty (Either (Notmuch.Thread a) (Notmuch.Message n a))
+     )
+  -> ExceptT Error m Thread
+processThread (threadid, toList -> thrdAndMsgs) =
+  handleIOError (\er -> throwE [i|IOError: #{er}|]) $ do
+    thread <-
+      tryJust [i|No Thread object found for Threadid #{threadid}|]
+      . viaNonEmpty head
+      . lefts
+      $ thrdAndMsgs
+    let msgs = rights thrdAndMsgs
+    results <- mapM processMessage msgs
+    let messages = sortOn (date :: Message -> UTCTime) results
+    subject    <- decodeUtf8 <$> Notmuch.threadSubject thread
+    totalCount <- Notmuch.threadTotalMessages thread
+    authors    <- (^. Notmuch.matchedAuthors) <$> Notmuch.threadAuthors thread
+    date       <- Notmuch.threadNewestDate thread
+    pure (Thread { subject, threadid, messages, totalCount, authors, date })
+
+
+messageToHtml :: Message -> Text
+messageToHtml Message { headers, body } =
+  T.intercalate "<br>\n"
+    $  ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
+    <> one (bodyToHtml body)
+
+bodyToHtml :: Body -> Text
+bodyToHtml (HTMLBody x) = fromMaybe x onlyBody
+   where onlyBody = renderTags . takeWhile (not . isTagCloseName "body") <$> (viaNonEmpty tail . dropWhile (not . isTagOpenName "body") . parseTags $ x)
+bodyToHtml (TextBody x) = T.intercalate "<br>\n" . T.splitOn "\n" $ x
+
+processMessage :: (MonadIO m, MonadCatch m) => Notmuch.Message n a -> m Message
+processMessage msg = do
+  fileName  <- Notmuch.messageFilename msg
+  date      <- Notmuch.messageDate msg
+  subject   <- tryHdr "subject" msg
+  fromField <- tryHdr "from" msg
+  toField   <- tryHdr "to" msg
+  cc        <- tryHdr "cc" msg
+  unsub     <- tryHdr "list-unsubscribe" msg
+  let hdrs = mapMaybe
+        (\(x, a) -> (x, ) <$> a)
+        [ ("Subject", subject)
+        , ("From"   , fromField)
+        , ("To"     , toField)
+        , ("Cc"     , cc)
+        , ("Date"   , Just (timestamp date))
+        , ("Unsubscribe"  , unsub)
+        ]
+  msgEither <- runExceptT $ withExceptT
+    (\er -> [i|Failed to read msg\nFilename:#{fileName}\nerror: #{er}|])
+    do
+      msgContent <- handleIOError (\er -> throwE [i|IOError: #{er}|])
+        $ readFileBS fileName
+      parseResult <- hoistEither . first toText $ MIME.parse
+        (MIME.message MIME.mime)
+        msgContent
+      textPart <- tryJust [i|No text or html part in message|] $ firstOf
+        (MIME.entities . filtered isHtml <> MIME.entities . filtered isTextPlain
+        )
+        parseResult
+      (if isHtml textPart then HTMLBody else TextBody)
+        <$> tryRight (mapLeft ("Could not decode message "<> ) $ decode textPart)
+  pure $ Message { date, headers = hdrs, body = either TextBody id msgEither }
+
+tryHdr :: MonadIO m => ByteString -> Notmuch.Message n a -> m (Maybe Text)
+tryHdr h msg =
+  ((\x -> if x /= "" then Just x else Nothing) . decodeUtf8 =<<)
+    <$> Notmuch.messageHeader h msg
+
+isTextPlain :: MIME.WireEntity -> Bool
+isTextPlain =
+  MIME.matchContentType "text" (Just "plain") . view MIME.contentType
+
+isHtml :: MIME.WireEntity -> Bool
+isHtml = MIME.matchContentType "text" (Just "html") . view MIME.contentType
+
+decode :: MIME.WireEntity -> Either Text Text
+decode = mapLeft show . view MIME.transferDecoded' >=> mapLeft show . view (charsetText' defaultCharsets)

apps/logfeed/Main.hs

@@ -0,0 +1,212 @@
+{-# LANGUAGE ViewPatterns, ScopedTypeVariables, NamedFieldPuns, OverloadedStrings, NoImplicitPrelude, ExtendedDefaultRules, QuasiQuotes, MultiWayIf #-}
+module Main where
+
+import qualified Data.List.Extra               as L
+import           Data.List.NonEmpty             ( groupBy
+                                                , zip
+                                                )
+import           Data.String.Interpolate        ( i )
+import           Data.Text                      ( intercalate
+                                                , replace
+                                                )
+import qualified Data.Text                     as Text
+import qualified Data.Time.Calendar            as T
+import qualified Data.Time.Clock               as T
+import qualified Data.Time.Format              as T
+import           Relude                  hiding ( intercalate
+                                                , zip
+                                                )
+import           System.Environment ()
+import           System.FilePattern.Directory   ( getDirectoryFiles )
+import           Text.Atom.Feed
+import           Text.Atom.Feed.Export          ( textFeed )
+import qualified Text.Megaparsec               as MP
+import qualified Text.Megaparsec.Char          as MP
+import qualified Text.Megaparsec.Char          as MPC
+import qualified Text.Megaparsec.Char.Lexer    as MP
+-- TODO: use Text instead of linked lists of chars
+
+type WeechatLog = [WeechatLine]
+data WeechatLine = WeechatLine
+  { wlDate :: Text
+  , wlTime :: Text
+  , wlNick :: Text
+  , wlMsg  :: Text
+  }
+  deriving (Show, Eq, Ord)
+-- TODO: specific handling of join/part/network messages
+
+data LogFile = LogFile
+  { path    :: Text
+  , server  :: Text
+  , channel :: Text
+  }
+  deriving (Show, Eq, Ord, Read)
+
+type Parser = MP.Parsec Text Text
+
+hyphen :: Parser Char
+hyphen = MP.char '-'
+parseDate :: Parser Text
+parseDate = do
+  year <- MP.count 4 MP.digitChar
+  void hyphen
+  month <- MP.count 2 MP.digitChar
+  void hyphen
+  day <- MP.count 2 MP.digitChar
+  pure [i|#{year}-#{month}-#{day}|]
+parseTime :: Parser Text
+parseTime = do
+  hour <- MP.count 2 MP.digitChar
+  void $ MP.char ':'
+  minute <- MP.count 2 MP.digitChar
+  void $ MP.char ':'
+  seconds <- MP.count 2 MP.digitChar
+  pure [i|#{hour}:#{minute}:#{seconds}|]
+dirSep :: Parser Char
+dirSep = MP.char '/'
+symbol :: Text -> Parser Text
+symbol = MP.symbol MPC.space
+folder :: Parser Text
+folder = toText <$> MP.manyTill MP.asciiChar dirSep
+
+matrixParser :: Text -> Parser LogFile
+matrixParser p = do
+  void $ MP.count 4 MP.digitChar -- year
+  void dirSep
+  prefix <- symbol "matrix:"
+  server <- folder
+  void folder -- room_id
+  void parseDate
+  void hyphen
+  void $ symbol server
+  void $ MP.char '.'
+  channel <- toText <$> MP.manyTill MP.asciiChar (symbol ".weechatlog")
+  pure $ LogFile p (prefix <> server) channel
+
+ircParser :: Text -> Parser LogFile
+ircParser p = do
+  void $ MP.count 4 MP.digitChar
+  void dirSep
+  prefix  <- symbol "irc:" :: Parser Text
+  server  <- folder
+  channel <- folder
+  void parseDate
+  void $ symbol ".weechatlog"
+  pure $ LogFile p (prefix <> server) channel
+
+logFolder :: Text
+logFolder = "/home/maralorn/logs/"
+
+main :: IO ()
+main = do
+  now <- T.getCurrentTime
+  let getFiles t p = L.groupSortOn (\x -> (channel x, server x))
+          .   mapMaybe ((\x -> MP.parseMaybe (p x) x) . toText)
+          <$> getDirectoryFiles
+                (toString logFolder)
+                (   T.formatTime T.defaultTimeLocale t
+                <$> [yesterday now, today now]
+                )
+  matrixFiles <- getFiles "%Y/matrix:*/*.!*/%Y-%m-%d-*.weechatlog" matrixParser
+  ircFiles    <- getFiles "%Y/irc:*/#*/%Y-%m-%d.weechatlog" ircParser
+  logs        <- mapM readLogFiles $ mapMaybe nonEmpty $ matrixFiles <> ircFiles
+  let entries = logs & mapMaybe (logToFeedEntry now)
+      feed    = nullFeed [i|weechat-logs-#{timestamp now}|]
+                         (TextString "Weechat Logs")
+                         (timestamp now)
+  [pathToWrite] <- getArgs
+  whenJust (textFeed feed { feedEntries = entries })
+    $ \file -> writeFileLText pathToWrite file
+
+today :: T.UTCTime -> T.Day
+today = T.utctDay
+yesterday :: T.UTCTime -> T.Day
+yesterday = T.addDays (negate 1) . today
+
+timestamp :: T.UTCTime -> Text
+timestamp = toText . T.formatTime T.defaultTimeLocale "%Y-%m-%d %H:%M"
+
+logToFeedEntry :: T.UTCTime -> Log -> Maybe Entry
+logToFeedEntry now =
+  \Log { logchannel, logserver, messages = filter msgFilter -> messages } ->
+    if not (null messages)
+      then Just (nullEntry [i|#{logserver}-#{logchannel}-#{timestamp now}|]
+                           (TextString [i|#{logchannel} - (#{logserver})|])
+                           (timestamp now)
+                )
+        { entryContent = Just $ HTMLContent $ printHTML messages
+        }
+      else Nothing
+ where
+  cutoff =
+    toText $ T.formatTime T.defaultTimeLocale "%Y-%m-%d 19:50" $ yesterday now
+  msgFilter msg = [i|#{wlDate msg} #{wlTime msg}|] >= cutoff
+
+data Log = Log
+  { logchannel :: Text
+  , logserver  :: Text
+  , messages   :: [WeechatLine]
+  }
+  deriving (Show, Eq, Ord)
+
+readLogFiles :: NonEmpty LogFile -> IO Log
+readLogFiles files =
+  readLogFile (head files)
+    <$> mapM (readFileText . toString . (logFolder <>) . path) files
+
+
+readLogFile :: LogFile -> NonEmpty Text -> Log
+readLogFile LogFile { channel, server } contents = Log
+  { logchannel = channel
+  , logserver  = server
+  , messages   = L.sortOn (\x -> (wlDate x, wlTime x))
+                 .   concat
+                 $   parseWeechatLog
+                 <$> contents
+  }
+
+parseWeechatLine :: Parser WeechatLine
+parseWeechatLine = do
+  date <- parseDate
+  void $ MP.char ' '
+  time <- parseTime
+  void MP.tab
+  nick <- toText <$> MP.manyTill MP.printChar MP.tab
+  WeechatLine date time nick <$> MP.takeRest
+
+parseWeechatLog :: Text -> [WeechatLine]
+parseWeechatLog = filter actualMessage . mapMaybe parseLine . lines
+ where
+  actualMessage = not . (`elem` ["-->", "<--", "--"]) . wlNick
+  parseLine     = MP.parseMaybe parseWeechatLine
+
+printHTML :: [WeechatLine] -> Text
+printHTML log = intercalate "\n" $ map printDay days
+ where
+  days = groupBy ((==) `on` wlDate) log
+  printDay ls =
+    intercalate "\n" $ ["<h3>" <> wlDate (head ls) <> "</h3>"] <> toList
+      (printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls)
+  printRow :: (WeechatLine, WeechatLine) -> Text
+  printRow (prevRow, curRow) =
+    "<i>" <> time <> "</i> <b>" <> printNick <> "</b> " <> message <> "<br>"
+   where
+    prevTime = Text.take 5 $ wlTime prevRow
+    curTime  = Text.take 5 $ wlTime curRow
+    prevNick = wlNick prevRow
+    curNick  = wlNick curRow
+    time | prevTime == curTime = ""
+         | otherwise           = curTime
+    nick | specialNick curNick = curNick
+         | prevNick == curNick = ""
+         | otherwise           = curNick
+    printNick = Text.dropWhile (`elem` ['&', '@']) nick
+    msg       = wlMsg curRow
+    message
+      | not (Text.null msg) && Text.head msg == '>'
+      = "|<i style='color: grey'>" <> escape (Text.tail msg) <> "</i>"
+      | otherwise
+      = escape msg
+  specialNick = (`elem` ["-->", "<--", "--", "*"])
+  escape      = replace "<" "&lt;" . replace ">" "&gt;"

apps/logfeed/default.nix

@@ -0,0 +1,3 @@
+{ pkgs ? import (import nix/sources.nix).nixpkgs {} }:
+with pkgs; with haskell.lib; with haskellPackages;
+callCabal2nix "logfeed" ./. { purebred-email = doJailbreak (unmarkBroken (dontCheck purebred-email)); }

apps/logfeed/logfeed.cabal

@@ -0,0 +1,65 @@
+cabal-version:      >=1.10
+
+-- Initial package description 'logfeed.cabal' generated by 'cabal init'.
+-- For further documentation, see http://haskell.org/cabal/users-guide/
+
+name:               logfeed
+version:            0.1.0.0
+
+-- synopsis:
+-- description:
+-- bug-reports:
+-- license:
+license-file:       LICENSE
+author:             Malte Brandy
+maintainer:         malte.brandy@maralorn.de
+
+-- copyright:
+-- category:
+build-type:         Simple
+extra-source-files: CHANGELOG.md
+
+executable log2rss
+  main-is:          Main.hs
+  ghc-options:      -Wall -Wcompat
+
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+      base
+    , containers
+    , extra
+    , feed                >=1.3.0.0
+    , filepattern
+    , megaparsec
+    , relude
+    , string-interpolate
+    , text
+    , time
+
+  default-language: Haskell2010
+
+executable mail2rss
+  main-is:          Mail.hs
+  ghc-options:      -Wall -Wcompat
+  build-depends:
+      base
+    , containers
+    , errors
+    , extra
+    , feed                >=1.3.0.0
+    , filepattern
+    , lens
+    , megaparsec
+    , notmuch
+    , purebred-email
+    , relude
+    , say
+    , string-interpolate
+    , text
+    , time
+    , optparse-applicative
+    , exceptions
+    , tagsoup
+
+  default-language: Haskell2010

apps/logfeed/nix/sources.json

@@ -0,0 +1,14 @@
+{
+    "nixpkgs": {
+        "branch": "nixos-unstable",
+        "description": "Nix Packages collection",
+        "homepage": "",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "f1c167688a6f81f4a51ab542e5f476c8c595e457",
+        "sha256": "00ac3axj7jdfcajj3macdydf9w9bvqqvgrqkh1xxr3rfi9q2fz1v",
+        "type": "tarball",
+        "url": "https://github.com/NixOS/nixpkgs/archive/f1c167688a6f81f4a51ab542e5f476c8c595e457.tar.gz",
+        "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
+    }
+}

apps/logfeed/nix/sources.nix

@@ -0,0 +1,194 @@
+# This file has been generated by Niv.
+
+let
+
+  #
+  # The fetchers. fetch_<type> fetches specs of type <type>.
+  #
+
+  fetch_file = pkgs: name: spec:
+    let
+      name' = sanitizeName name + "-src";
+    in
+      if spec.builtin or true then
+        builtins_fetchurl { inherit (spec) url sha256; name = name'; }
+      else
+        pkgs.fetchurl { inherit (spec) url sha256; name = name'; };
+
+  fetch_tarball = pkgs: name: spec:
+    let
+      name' = sanitizeName name + "-src";
+    in
+      if spec.builtin or true then
+        builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
+      else
+        pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
+
+  fetch_git = name: spec:
+    let
+      ref =
+        if spec ? ref then spec.ref else
+          if spec ? branch then "refs/heads/${spec.branch}" else
+            if spec ? tag then "refs/tags/${spec.tag}" else
+              abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";
+      submodules = if spec ? submodules then spec.submodules else false;
+      submoduleArg =
+        let
+          nixSupportsSubmodules = builtins.compareVersions builtins.nixVersion "2.4" >= 0;
+          emptyArgWithWarning =
+            if submodules == true
+            then
+              builtins.trace
+                (
+                  "The niv input \"${name}\" uses submodules "
+                  + "but your nix's (${builtins.nixVersion}) builtins.fetchGit "
+                  + "does not support them"
+                )
+                {}
+            else {};
+        in
+          if nixSupportsSubmodules
+          then { inherit submodules; }
+          else emptyArgWithWarning;
+    in
+      builtins.fetchGit
+        ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg);
+
+  fetch_local = spec: spec.path;
+
+  fetch_builtin-tarball = name: throw
+    ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`.
+        $ niv modify ${name} -a type=tarball -a builtin=true'';
+
+  fetch_builtin-url = name: throw
+    ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`.
+        $ niv modify ${name} -a type=file -a builtin=true'';
+
+  #
+  # Various helpers
+  #
+
+  # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695
+  sanitizeName = name:
+    (
+      concatMapStrings (s: if builtins.isList s then "-" else s)
+        (
+          builtins.split "[^[:alnum:]+._?=-]+"
+            ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name)
+        )
+    );
+
+  # The set of packages used when specs are fetched using non-builtins.
+  mkPkgs = sources: system:
+    let
+      sourcesNixpkgs =
+        import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; };
+      hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
+      hasThisAsNixpkgsPath = <nixpkgs> == ./.;
+    in
+      if builtins.hasAttr "nixpkgs" sources
+      then sourcesNixpkgs
+      else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then
+        import <nixpkgs> {}
+      else
+        abort
+          ''
+            Please specify either <nixpkgs> (through -I or NIX_PATH=nixpkgs=...) or
+            add a package called "nixpkgs" to your sources.json.
+          '';
+
+  # The actual fetching function.
+  fetch = pkgs: name: spec:
+
+    if ! builtins.hasAttr "type" spec then
+      abort "ERROR: niv spec ${name} does not have a 'type' attribute"
+    else if spec.type == "file" then fetch_file pkgs name spec
+    else if spec.type == "tarball" then fetch_tarball pkgs name spec
+    else if spec.type == "git" then fetch_git name spec
+    else if spec.type == "local" then fetch_local spec
+    else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
+    else if spec.type == "builtin-url" then fetch_builtin-url name
+    else
+      abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
+
+  # If the environment variable NIV_OVERRIDE_${name} is set, then use
+  # the path directly as opposed to the fetched source.
+  replace = name: drv:
+    let
+      saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;
+      ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
+    in
+      if ersatz == "" then drv else
+        # this turns the string into an actual Nix path (for both absolute and
+        # relative paths)
+        if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}";
+
+  # Ports of functions for older nix versions
+
+  # a Nix version of mapAttrs if the built-in doesn't exist
+  mapAttrs = builtins.mapAttrs or (
+    f: set: with builtins;
+    listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))
+  );
+
+  # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295
+  range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1);
+
+  # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257
+  stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1));
+
+  # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
+  stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
+  concatMapStrings = f: list: concatStrings (map f list);
+  concatStrings = builtins.concatStringsSep "";
+
+  # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331
+  optionalAttrs = cond: as: if cond then as else {};
+
+  # fetchTarball version that is compatible between all the versions of Nix
+  builtins_fetchTarball = { url, name ? null, sha256 }@attrs:
+    let
+      inherit (builtins) lessThan nixVersion fetchTarball;
+    in
+      if lessThan nixVersion "1.12" then
+        fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
+      else
+        fetchTarball attrs;
+
+  # fetchurl version that is compatible between all the versions of Nix
+  builtins_fetchurl = { url, name ? null, sha256 }@attrs:
+    let
+      inherit (builtins) lessThan nixVersion fetchurl;
+    in
+      if lessThan nixVersion "1.12" then
+        fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
+      else
+        fetchurl attrs;
+
+  # Create the final "sources" from the config
+  mkSources = config:
+    mapAttrs (
+      name: spec:
+        if builtins.hasAttr "outPath" spec
+        then abort
+          "The values in sources.json should not have an 'outPath' attribute"
+        else
+          spec // { outPath = replace name (fetch config.pkgs name spec); }
+    ) config.sources;
+
+  # The "config" used by the fetchers
+  mkConfig =
+    { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
+    , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
+    , system ? builtins.currentSystem
+    , pkgs ? mkPkgs sources system
+    }: rec {
+      # The sources, i.e. the attribute set of spec name to spec
+      inherit sources;
+
+      # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
+      inherit pkgs;
+    };
+
+in
+mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }

apps/logfeed/shell.nix

@@ -0,0 +1,12 @@
+{ pkgs ? import (import nix/sources.nix).nixpkgs {} }:
+let
+  inherit (pkgs) haskellPackages;
+in
+haskellPackages.shellFor {
+  withHoogle = true;
+  packages = p: [ (import ./. { inherit pkgs; }) ];
+  buildInputs = builtins.attrValues {
+    inherit (haskellPackages) hlint cabal-install notmuch hsemail;
+    inherit (pkgs) coreutils zlib;
+  };
+}