From 5e400b5b2478fa59a84cc9a69c525ada4be6f0c3 Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Sat, 8 Apr 2023 12:59:01 +0200 Subject: chore(users/Profpatsch): bring reverse-haskell-deps into shape Add a cabal file and move into subdir. Use MyPrelude & fix a few linter warnings. Change-Id: I19d5ba47be789fc24f8e02ee8721f73c706ae3e9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/8465 Reviewed-by: Profpatsch Autosubmit: Profpatsch Tested-by: BuildkiteCI --- .../reverse-haskell-deps/ReverseHaskellDeps.hs | 76 ++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs (limited to 'users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs') diff --git a/users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs b/users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs new file mode 100644 index 000000000000..0e18ce8a6b37 --- /dev/null +++ b/users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Main where + +import Data.ByteString qualified as ByteString +import Data.Either +import Data.List qualified as List +import Data.Maybe +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.Encoding qualified +import MyPrelude +import Numeric.Natural +import Text.HTML.TagSoup qualified as Tag +import Text.Nicify +import Text.Read qualified as Read + +parseNat :: Text -> Maybe Natural +parseNat = Read.readMaybe . textToString + +printNice :: Show a => a -> IO () +printNice = putStrLn . nicify . show + +type Tag = Tag.Tag Text + +main = do + reverseHtml <- readStdinUtf8 + printNice $ List.sortOn snd $ packagesAndReverseDeps reverseHtml + where + readStdinUtf8 = bytesToTextUtf8Lenient <$> ByteString.getContents + +-- | reads the table provided by https://packdeps.haskellers.com/reverse +-- figuring out all sections (starting with the link to the package name), +-- then figuring out the name of the package and the first column, +-- which is the number of reverse dependencies of the package +packagesAndReverseDeps :: Text -> [(Text, Natural)] +packagesAndReverseDeps reverseHtml = do + let tags = Tag.parseTags reverseHtml + let sections = Tag.partitions (isJust . reverseLink) tags + let sectionName [] = "" + sectionName (sect : _) = sect & reverseLink & fromMaybe "" + let sectionNames = map sectionName sections + mapMaybe + ( \(name :: Text, sect) -> do + reverseDeps <- firstNaturalNumber sect + pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text, Natural) + ) + $ zip sectionNames sections + where + reverseLink = \case + Tag.TagOpen "a" attrs -> findMaybe attrReverseLink attrs + _ -> Nothing + + attrReverseLink = \case + ("href", lnk) -> + if + | "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk + | otherwise -> Nothing + _ -> Nothing + + sectionPackageName :: Text -> [Tag] -> Text + sectionPackageName sectionName = \case + (_ : Tag.TagText name : _) -> name + (_ : el : _) -> sectionName + xs -> sectionName + + firstNaturalNumber :: [Tag] -> Maybe Natural + firstNaturalNumber = + findMaybe + ( \case + Tag.TagText t -> parseNat t + _ -> Nothing + ) -- cgit 1.4.1