├── Procfile ├── .gitignore ├── Setup.hs ├── nix ├── default.nix ├── sources.json └── sources.nix ├── stack.yaml ├── nixpkgs.nix ├── default.nix ├── .github └── workflows │ └── main.yml ├── src ├── Main.hs ├── index.hamlet └── Channels.hs ├── README.md ├── stack.yaml.lock ├── howoldis.cabal └── LICENSE /Procfile: -------------------------------------------------------------------------------- 1 | web: .local/bin/howoldis 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.stack-work 2 | /dist-newstyle 3 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /nix/default.nix: -------------------------------------------------------------------------------- 1 | { sources ? import ./sources.nix }: 2 | import sources.nixpkgs (import sources."haskell.nix") 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: 5 | - haquery-0.1.1.3 6 | nix: 7 | packages: [git,zlib] 8 | resolver: lts-14.13 9 | allow-newer: true # for haquery 10 | -------------------------------------------------------------------------------- /nixpkgs.nix: -------------------------------------------------------------------------------- 1 | import (builtins.fetchTarball { 2 | url = https://github.com/NixOS/nixpkgs/archive/7818f30cc4b6b282ecd361a5e62d1c99ec8c0c78.tar.gz; 3 | sha256 = "13dvckd0c8q2739p4nygh9v8b2h57796kq7jwpi4bqx6h6hibi84"; 4 | }) { config = {}; } 5 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import ./nix { } }: 2 | 3 | rec { 4 | pkgSet = pkgs.haskell-nix.stackProject { 5 | src = pkgs.haskell-nix.haskellLib.cleanGit { src = ./.; }; 6 | }; 7 | haskellNixRoots = pkgs.haskell-nix.haskellNixRoots // { 8 | ghc-extra-projects = { }; 9 | }; 10 | howoldis = pkgSet.howoldis.components.exes.howoldis; 11 | } 12 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: "Build" 2 | on: 3 | pull_request: 4 | push: 5 | jobs: 6 | build: 7 | runs-on: ubuntu-latest 8 | steps: 9 | - uses: actions/checkout@v1 10 | - uses: cachix/install-nix-action@v6 11 | - uses: cachix/cachix-action@v3 12 | with: 13 | name: madjar-ci 14 | signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' 15 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | import Channels (channels) 5 | import Control.Monad.Trans (liftIO) 6 | import System.Environment (getEnvironment) 7 | import Text.Blaze.Html.Renderer.Text (renderHtml) 8 | import Text.Hamlet (shamletFile) 9 | import Web.Scotty 10 | 11 | main :: IO () 12 | main = do 13 | env <- getEnvironment 14 | let port = maybe 3000 read $ lookup "PORT" env 15 | scotty port $ do 16 | get "/" $ do 17 | html $ renderHtml $(shamletFile "src/index.hamlet") 18 | get "/api/channels" $ do 19 | allChannels <- liftIO channels 20 | json allChannels 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # How old is that NixOS Channel? 2 | 3 | **IMPORTANT NOTE**: Following an [update to the nixos.org](https://discourse.nixos.org/t/announcement-moving-nixos-org-to-netlify/6212/27) website, this project doesn't work anymore. However, https://status.nixos.org/ may be exactly what you're looking for! 4 | 5 | A small web application that gives the sort answer to that question, and some links to the long answers. 6 | 7 | My first web application in Haskell, built with scotty. 8 | 9 | It is running at http://howoldis.herokuapp.com 10 | 11 | # Development 12 | 13 | 14 | nix-shell -p stack --run "stack build --nix --file-watch --exec howoldis" 15 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: haquery-0.1.1.3@sha256:b2cbed9ef0c3824ea652b069d1ebb361699e1793b1dd5685e128d25bdc897ff1,879 9 | pantry-tree: 10 | size: 206 11 | sha256: 1668fb57844ae297d6892d527f1217f135ce407b3bbb5e17d20224714b8912a6 12 | original: 13 | hackage: haquery-0.1.1.3 14 | snapshots: 15 | - completed: 16 | size: 525876 17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/13.yaml 18 | sha256: 4a0e79eb194c937cc2a1852ff84d983c63ac348dc6bad5f38d20cab697036eef 19 | original: lts-14.13 20 | -------------------------------------------------------------------------------- /howoldis.cabal: -------------------------------------------------------------------------------- 1 | -- Initial howoldis.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: howoldis 5 | version: 0.1.0.0 6 | synopsis: Little web app displaying the age of the last NixOS channels 7 | -- description: 8 | license: BSD3 9 | license-file: LICENSE 10 | author: Georges Dubus 11 | maintainer: georges.dubus@compiletoi.net 12 | -- copyright: 13 | category: Web 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | executable howoldis 19 | hs-source-dirs: src 20 | main-is: Main.hs 21 | other-modules: Channels 22 | build-depends: base >=4.8 && <5.0 23 | , wreq 24 | , lens 25 | , http-client 26 | , bytestring 27 | , split 28 | , aeson 29 | , parallel-io 30 | , blaze-html >= 0.7.0 31 | , mtl >= 2.1.3 32 | , haquery > 0.1.1.2 33 | , scotty >= 0.9 34 | , shakespeare >= 2.0.0 35 | , text >= 1.2.0 36 | , time >= 1.5 37 | , tz 38 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror 39 | default-language: Haskell2010 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Georges Dubus 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Georges Dubus nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /nix/sources.json: -------------------------------------------------------------------------------- 1 | { 2 | "haskell.nix": { 3 | "branch": "master", 4 | "description": "Alternative Haskell Infrastructure for Nixpkgs", 5 | "homepage": "https://input-output-hk.github.io/haskell.nix", 6 | "owner": "input-output-hk", 7 | "repo": "haskell.nix", 8 | "rev": "9b10945d98d3a8d53ef7e0c47af789261c289012", 9 | "sha256": "06p56jm99mgzv1fsdjgkv0kk0gn3ghslqis08z3a59qw6n7mn40c", 10 | "type": "tarball", 11 | "url": "https://github.com/input-output-hk/haskell.nix/archive/9b10945d98d3a8d53ef7e0c47af789261c289012.tar.gz", 12 | "url_template": "https://github.com///archive/.tar.gz" 13 | }, 14 | "niv": { 15 | "branch": "master", 16 | "description": "Easy dependency management for Nix projects", 17 | "homepage": "https://github.com/nmattia/niv", 18 | "owner": "nmattia", 19 | "repo": "niv", 20 | "rev": "1dd094156b249586b66c16200ecfd365c7428dc0", 21 | "sha256": "1b2vjnn8iac5iiqszjc2v1s1ygh0yri998c0k3s4x4kn0dsqik21", 22 | "type": "tarball", 23 | "url": "https://github.com/nmattia/niv/archive/1dd094156b249586b66c16200ecfd365c7428dc0.tar.gz", 24 | "url_template": "https://github.com///archive/.tar.gz" 25 | }, 26 | "nixpkgs": { 27 | "branch": "nixpkgs-unstable", 28 | "description": "A read-only mirror of NixOS/nixpkgs tracking the released channels. Send issues and PRs to", 29 | "homepage": "https://github.com/NixOS/nixpkgs", 30 | "owner": "NixOS", 31 | "repo": "nixpkgs-channels", 32 | "rev": "4b0508a58539e222fb40142bbb260d2c23fdab53", 33 | "sha256": "1xl96fqq4wi4csb3p5ia47xami8r2bcp1f0n5czjjjavbjpmam7y", 34 | "type": "tarball", 35 | "url": "https://github.com/NixOS/nixpkgs-channels/archive/4b0508a58539e222fb40142bbb260d2c23fdab53.tar.gz", 36 | "url_template": "https://github.com///archive/.tar.gz" 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /nix/sources.nix: -------------------------------------------------------------------------------- 1 | # This file has been generated by Niv. 2 | 3 | # A record, from name to path, of the third-party packages 4 | with rec 5 | { 6 | pkgs = 7 | if hasNixpkgsPath 8 | then 9 | if hasThisAsNixpkgsPath 10 | then import (builtins_fetchTarball { inherit (sources_nixpkgs) url sha256; }) {} 11 | else import {} 12 | else 13 | import (builtins_fetchTarball { inherit (sources_nixpkgs) url sha256; }) {}; 14 | 15 | sources_nixpkgs = 16 | if builtins.hasAttr "nixpkgs" sources 17 | then sources.nixpkgs 18 | else abort 19 | '' 20 | Please specify either (through -I or NIX_PATH=nixpkgs=...) or 21 | add a package called "nixpkgs" to your sources.json. 22 | ''; 23 | 24 | # fetchTarball version that is compatible between all the versions of Nix 25 | builtins_fetchTarball = 26 | { url, sha256 }@attrs: 27 | let 28 | inherit (builtins) lessThan nixVersion fetchTarball; 29 | in 30 | if lessThan nixVersion "1.12" then 31 | fetchTarball { inherit url; } 32 | else 33 | fetchTarball attrs; 34 | 35 | # fetchurl version that is compatible between all the versions of Nix 36 | builtins_fetchurl = 37 | { url, sha256 }@attrs: 38 | let 39 | inherit (builtins) lessThan nixVersion fetchurl; 40 | in 41 | if lessThan nixVersion "1.12" then 42 | fetchurl { inherit url; } 43 | else 44 | fetchurl attrs; 45 | 46 | # A wrapper around pkgs.fetchzip that has inspectable arguments, 47 | # annoyingly this means we have to specify them 48 | fetchzip = { url, sha256 }@attrs: pkgs.fetchzip attrs; 49 | 50 | # A wrapper around pkgs.fetchurl that has inspectable arguments, 51 | # annoyingly this means we have to specify them 52 | fetchurl = { url, sha256 }@attrs: pkgs.fetchurl attrs; 53 | 54 | hasNixpkgsPath = (builtins.tryEval ).success; 55 | hasThisAsNixpkgsPath = 56 | (builtins.tryEval ).success && == ./.; 57 | 58 | sources = builtins.fromJSON (builtins.readFile ./sources.json); 59 | 60 | mapAttrs = builtins.mapAttrs or 61 | (f: set: with builtins; 62 | listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))); 63 | 64 | # borrowed from nixpkgs 65 | functionArgs = f: f.__functionArgs or (builtins.functionArgs f); 66 | callFunctionWith = autoArgs: f: args: 67 | let auto = builtins.intersectAttrs (functionArgs f) autoArgs; 68 | in f (auto // args); 69 | 70 | getFetcher = spec: 71 | let fetcherName = 72 | if builtins.hasAttr "type" spec 73 | then builtins.getAttr "type" spec 74 | else "builtin-tarball"; 75 | in builtins.getAttr fetcherName { 76 | "tarball" = fetchzip; 77 | "builtin-tarball" = builtins_fetchTarball; 78 | "file" = fetchurl; 79 | "builtin-url" = builtins_fetchurl; 80 | }; 81 | }; 82 | # NOTE: spec must _not_ have an "outPath" attribute 83 | mapAttrs (_: spec: 84 | if builtins.hasAttr "outPath" spec 85 | then abort 86 | "The values in sources.json should not have an 'outPath' attribute" 87 | else 88 | if builtins.hasAttr "url" spec && builtins.hasAttr "sha256" spec 89 | then 90 | spec // 91 | { outPath = callFunctionWith spec (getFetcher spec) { }; } 92 | else spec 93 | ) sources 94 | -------------------------------------------------------------------------------- /src/index.hamlet: -------------------------------------------------------------------------------- 1 | $doctype 5 2 | 3 | "How up to date are NixOS channels?" 4 | <!-- Latest compiled and minified CSS --> 5 | <link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u" crossorigin="anonymous"> 6 | <script src="https://ajax.googleapis.com/ajax/libs/jquery/1.12.4/jquery.min.js"> 7 | <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha384-Tc5IQib027qvyjSMfHjOMaLkfuWVxZxUPnCJA7l2mCWNIpG9mGCD8wGNIcPD7Txa" crossorigin="anonymous"> 8 | <meta name="viewport" content="width=device-width, initial-scale=1"> 9 | <body> 10 | <div class=container> 11 | 12 | <h3>How does channel update? 13 | 14 | <div class="panel-group" id="accordion" role="tablist" aria-multiselectable="true"> 15 | <div class="panel panel-default"> 16 | <div class="panel-heading" role="tab" id="headingOne"> 17 | <h4 class="panel-title"> 18 | <a class="collapsed" role="button" data-toggle="collapse" data-parent="#accordion" href="#collapseOne" aria-expanded="false" aria-controls="collapseOne"> 19 | 1. Git commit <span class="glyphicon glyphicon-menu-down" aria-hidden="true"></span> 20 | <div id="collapseOne" class="panel-collapse collapse" role="tabpanel" aria-labelledby="headingOne"> 21 | <div class="panel-body"> 22 | Anyone with commit access can push changes to either <strong>master</strong> 23 | or one of the <strong>release-XX.XX</strong> branches. 24 | <div class="panel panel-default"> 25 | <div class="panel-heading" role="tab" id="headingTwo"> 26 | <h4 class="panel-title"> 27 | <a role="button" data-toggle="collapse" data-parent="#accordion" href="#collapseTwo" aria-expanded="false" aria-controls="collapseOne"> 28 | 2. Hydra build <span class="glyphicon glyphicon-menu-down" aria-hidden="true"></span> 29 | <div id="collapseTwo" class="panel-collapse collapse" role="tabpanel" aria-labelledby="headingTwo"> 30 | <div class="panel-body"> 31 | <p> 32 | Each channel has an associated <i>jobset</i> on <a href="http://nixos.org/hydra/">Hydra (Nix CI)</a> that is a collection of individual <i>jobs</i>. A <i>job</i> roughly corresponds to building a particular package, which itself may depend on other packages built by other <i>jobs</i>. 33 | <p> 34 | Before a channel can update, its associated <i>jobset</i> must be finished building, though the building of some jobs may fail. 35 | <p> 36 | As long as certain special <i>jobs</i> -- <i>unstable</i> for nixpkgs, and <i>tested</i> for nixos -- build successfully, the channel can update. The role of these special jobs is to ensure that essential functionality is present on each channel update. 37 | 38 | 39 | <p> 40 | There are two major differences between those jobsets: 41 | 42 | <ul> 43 | <li> 44 | <strong>nixpkgs-unstable</strong> 45 | <ul> 46 | <li>builds all packages for supported platforms (Linux, Darwin) 47 | <li><a href="https://github.com/NixOS/nixpkgs/blob/master/pkgs/top-level/release.nix#L34-L70">unstable</a> job that consists of most commonly used packages 48 | <li> 49 | <strong>nixos-*</strong> 50 | <ul> 51 | <li>builds all packages and NixOS machinery only for Linux 52 | <li><a href="https://github.com/NixOS/nixpkgs/blob/master/nixos/release-combined.nix#L34-L105">tested</a> job that consists of mostly NixOS tests firing up qemu instances with different kinds of configurations 53 | <div class="panel panel-default"> 54 | <div class="panel-heading" role="tab" id="headingThree"> 55 | <h4 class="panel-title"> 56 | <a role="button" data-toggle="collapse" data-parent="#accordion" href="#collapseThree" aria-expanded="false" aria-controls="collapseOne"> 57 | 3. Channel update <span class="glyphicon glyphicon-menu-down" aria-hidden="true"></span> 58 | <div id="collapseThree" class="panel-collapse collapse" role="tabpanel" aria-labelledby="headingTwo"> 59 | <div class="panel-body"> 60 | <p> 61 | For a channel to be updated two conditions need to be satisfied: 62 | 63 | <ul> 64 | <li>Particular jobset evaluation needs to be completely built ie. no more queued jobs, even if some jobs may fail 65 | <li>Particular jobset evaluation's <strong>tested/unstable</strong> job needs to be built succesfully 66 | 67 | <p> 68 | The nixos.org server has a cronjob for which <a href="https://github.com/NixOS/nixos-channel-scripts">nixos-channel-scripts</a> 69 | are executed and poll for the newest jobset that satisfies the above two conditions and trigger 70 | a channel update. 71 | 72 | <p> 73 | Once triggered, release files such as ISOs are copied. For the NixOS channel 74 | <a href="https://github.com/NixOS/nixos-channel-scripts/blob/master/generate-programs-index.cc"> 75 | command-not-found 76 | index is generated, which can take some time since it has to fetch all packages. 77 | 78 | <p> 79 | <strong>nixpkgs</strong> is quickly updated since none of the above needs to happen once a channel update is triggered. 80 | 81 | <div class=page-header> 82 | <h3>How up to date are NixOS channels? 83 | 84 | <p> 85 | See <a href="https://status.nixos.org/">NixOS status page</a>. 86 | 87 | <div class=container> 88 | Made by <a href="https://twitter.com/georgesdubus">Georges Dubus</a>, code is on <a href="https://github.com/madjar/howoldis">github</a> 89 | -------------------------------------------------------------------------------- /src/Channels.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | 6 | module Channels 7 | ( Channel (..), 8 | label, 9 | humantime, 10 | jobset, 11 | commit, 12 | channels, 13 | ) 14 | where 15 | 16 | import Control.Concurrent.ParallelIO.Global (parallelE) 17 | import Control.Exception (throwIO, try) 18 | import Control.Lens ((^.)) 19 | import Control.Monad (unless) 20 | import Data.Aeson (ToJSON) 21 | import qualified Data.ByteString.Char8 as C8 22 | import Data.Either (lefts, rights) 23 | import Data.List (null, sortOn) 24 | import Data.List.Split (splitOn) 25 | import Data.Maybe (fromMaybe) 26 | import Data.Monoid ((<>)) 27 | import Data.Ord (Down (..)) 28 | import qualified Data.Text as DT 29 | import Data.Text (Text, pack, replace, unpack) 30 | import Data.Time.Calendar (fromGregorian) 31 | import Data.Time.Clock (NominalDiffTime, UTCTime (..), diffUTCTime, getCurrentTime) 32 | import Data.Time.Format (defaultTimeLocale, parseTimeM) 33 | import Data.Time.Zones 34 | import Data.Time.Zones.All 35 | import GHC.Generics 36 | import qualified Haquery as HQ 37 | import Network.HTTP.Client 38 | ( HttpException (HttpExceptionRequest), 39 | HttpExceptionContent (StatusCodeException), 40 | responseHeaders, 41 | ) 42 | import qualified Network.Wreq as W 43 | import Network.Wreq.Session (Session) 44 | import qualified Network.Wreq.Session as WS 45 | 46 | {- NOTE 47 | 48 | The difference between RawChannel and Channel is not very interesting. I should re-design this. 49 | The interesting information to push are: 50 | - last commit 51 | - last eval 52 | - last successful build (if eval is not finished, what is queued? If not successful, what failed?) 53 | - last successful build with finished eval 54 | - last release of the channel 55 | 56 | Maybe on a separate page that displays and explain the whole funnel? 57 | 58 | -} 59 | 60 | data RawChannel 61 | = RawChannel 62 | { rname :: Text, 63 | rtime :: UTCTime 64 | } 65 | deriving (Show) 66 | 67 | data Channel 68 | = Channel 69 | { name :: Text, 70 | time :: NominalDiffTime, 71 | link :: String 72 | } 73 | deriving (Show, Generic) 74 | 75 | instance ToJSON Channel 76 | 77 | parseTime :: String -> UTCTime 78 | parseTime = maybe nixEpoch (localTimeToUTCTZ tz) . parseTimeM @Maybe True defaultTimeLocale "%F %R" 79 | where 80 | tz = tzByLabel Europe__Rome -- CET/CEST 81 | nixEpoch = UTCTime (fromGregorian 2006 1 1) 0 82 | 83 | findGoodChannels :: Text -> [RawChannel] 84 | findGoodChannels html = map rowToChannel rows 85 | where 86 | rows = drop 2 $ concatMap (HQ.select "tr:has(a)") $ HQ.parseHtml html 87 | rowToChannel tag = RawChannel {..} 88 | where 89 | rname = replaceEscapedQuotes $ fromMaybe "" $ HQ.attr "href" $ head $ HQ.select "a" tag 90 | rtime = parseTime $ unpack $ innerText $ head $ HQ.select "*:nth-child(3)" tag 91 | -- TODO: Why do these quotes leak into tag content? 92 | replaceEscapedQuotes = replace "\\\"" "" 93 | 94 | -- TODO: Remove once merged https://github.com/crufter/haquery/pull/6 95 | innerText :: HQ.Tag -> Text 96 | innerText (HQ.Doctype _ text) = text 97 | innerText (HQ.Text _ text) = text 98 | innerText (HQ.Tag _ _ _ children) = DT.concat $ map innerText children 99 | 100 | -- | Enrich a RawChannel into a Channel by finding what it links to 101 | makeChannel :: Session -> UTCTime -> RawChannel -> IO Channel 102 | makeChannel sess current channel = do 103 | res <- try $ WS.head_ sess . unpack $ "https://nixos.org/channels/" <> rname channel 104 | link <- case res of 105 | -- We get 302 redirect with Location header, no need to go further 106 | -- Propagate the rest of the errors 107 | Left (HttpExceptionRequest _ (StatusCodeException resp _)) -> 108 | return $ C8.unpack $ snd $ head $ filter ((== "Location") . fst) . responseHeaders $ resp 109 | Right response -> return $ C8.unpack $ response ^. W.responseHeader "Location" 110 | Left e -> throwIO e 111 | let diff = diffUTCTime current (rtime channel) 112 | return $ 113 | Channel 114 | (rname channel) 115 | diff 116 | link 117 | 118 | -- | The list of the current NixOS channels 119 | channels :: IO [Channel] 120 | channels = do 121 | sess <- WS.newAPISession 122 | r <- WS.get sess "https://nixos.org/channels/" 123 | current <- getCurrentTime 124 | let html = pack $ show $ r ^. W.responseBody 125 | responseOrExc <- 126 | parallelE $ 127 | makeChannel sess current <$> findGoodChannels html 128 | unless (null $ lefts responseOrExc) $ print $ lefts responseOrExc 129 | return $ sortOn (Down . parseVersion) $ rights responseOrExc 130 | where 131 | parseVersion = DT.takeWhile (/= '-') . DT.drop 1 . DT.dropWhile (/= '-') . name 132 | 133 | -- Display helpers 134 | 135 | data Label = Danger | Warning | Success | NoLabel deriving (Generic) 136 | 137 | instance Show Label where 138 | show Danger = "danger" 139 | show Warning = "warning" 140 | show Success = "success" 141 | show NoLabel = "" 142 | 143 | instance ToJSON Label 144 | 145 | label :: Channel -> Label 146 | label = diffToLabel . time 147 | 148 | -- | Takes time since last update to the channel and colors it based on it's age 149 | diffToLabel :: NominalDiffTime -> Label 150 | diffToLabel time 151 | | days < 3 = Success 152 | | days < 10 = Warning 153 | | otherwise = Danger 154 | where 155 | days = time / (60 * 60 * 24) 156 | 157 | humantime :: Channel -> Text 158 | humantime = humanTimeDiff . time 159 | 160 | humanTimeDiff :: NominalDiffTime -> Text 161 | humanTimeDiff d 162 | | days > 1 = doShow days (pluralize days "day" "days") 163 | | hours > 1 = doShow hours (pluralize hours "hour" "hours") 164 | | minutes > 1 = doShow minutes (pluralize minutes "minute" "minutes") 165 | | otherwise = doShow d (pluralize d "second" "seconds") 166 | where 167 | minutes = d / 60 168 | hours = minutes / 60 169 | days = hours / 24 170 | doShow x unit = pack (show @Int $ truncate x) <> " " <> unit 171 | -- diffUTCTime contains a float-like value, so everything below `2` will be treated as 1 172 | -- Furthermore a 0 causes the next lower unit, so only 2 and more will be interpreted 173 | -- as plural. 174 | pluralize n s p 175 | | n < 2 = s 176 | | otherwise = p 177 | 178 | jobset :: Channel -> Maybe Text 179 | jobset = toJobset . name 180 | 181 | toJobset :: Text -> Maybe Text 182 | toJobset c 183 | | c == "nixos-unstable" = Just "nixos/trunk-combined/tested" 184 | | c == "nixos-unstable-small" = Just "nixos/unstable-small/tested" 185 | | c == "nixpkgs-unstable" = Just "nixpkgs/trunk/unstable" 186 | | "nixos-" `DT.isPrefixOf` c = Just $ "nixos/release-" <> DT.drop 6 c <> "/tested" 187 | | "-darwin" `DT.isSuffixOf` c = Just $ "nixpkgs/" <> c <> "/darwin-tested" 188 | | otherwise = Nothing 189 | 190 | commit :: Channel -> String 191 | commit = parseCommit . link 192 | 193 | parseCommit :: String -> String 194 | parseCommit url = last $ splitOn "." url 195 | --------------------------------------------------------------------------------