diff --git a/apps/logfeed/.gitignore b/apps/logfeed/.gitignore new file mode 100644 index 00000000..121be88f --- /dev/null +++ b/apps/logfeed/.gitignore @@ -0,0 +1,3 @@ +/dist-newstyle +/result +.direnv diff --git a/apps/logfeed/Mail.hs b/apps/logfeed/Mail.hs new file mode 100644 index 00000000..395c9262 --- /dev/null +++ b/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|
\n
\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 "
\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 "
\n" + $ ((\(name, content) -> [i|#{name}: #{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 "
\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) diff --git a/apps/logfeed/Main.hs b/apps/logfeed/Main.hs new file mode 100644 index 00000000..96c18fe0 --- /dev/null +++ b/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" $ ["

" <> wlDate (head ls) <> "

"] <> toList + (printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls) + printRow :: (WeechatLine, WeechatLine) -> Text + printRow (prevRow, curRow) = + "" <> time <> " " <> printNick <> " " <> message <> "
" + 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 == '>' + = "|" <> escape (Text.tail msg) <> "" + | otherwise + = escape msg + specialNick = (`elem` ["-->", "<--", "--", "*"]) + escape = replace "<" "<" . replace ">" ">" diff --git a/apps/logfeed/default.nix b/apps/logfeed/default.nix new file mode 100644 index 00000000..7ebbb4d9 --- /dev/null +++ b/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)); } diff --git a/apps/logfeed/logfeed.cabal b/apps/logfeed/logfeed.cabal new file mode 100644 index 00000000..6a7c5435 --- /dev/null +++ b/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 diff --git a/apps/logfeed/nix/sources.json b/apps/logfeed/nix/sources.json new file mode 100644 index 00000000..eadbed21 --- /dev/null +++ b/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///archive/.tar.gz" + } +} diff --git a/apps/logfeed/nix/sources.nix b/apps/logfeed/nix/sources.nix new file mode 100644 index 00000000..9a01c8ac --- /dev/null +++ b/apps/logfeed/nix/sources.nix @@ -0,0 +1,194 @@ +# This file has been generated by Niv. + +let + + # + # The fetchers. fetch_ fetches specs of 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 = == ./.; + in + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import {} + else + abort + '' + Please specify either (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); } diff --git a/apps/logfeed/shell.nix b/apps/logfeed/shell.nix new file mode 100644 index 00000000..72306cfe --- /dev/null +++ b/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; + }; +}