tvl-depot/users/Profpatsch/reverse-haskell-deps/ReverseHaskellDeps.hs
Profpatsch 5e400b5b24 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 <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
2023-04-08 12:25:05 +00:00

76 lines
2.3 KiB
Haskell

{-# 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 [] = "<unknown section>"
sectionName (sect : _) = sect & reverseLink & fromMaybe "<unknown section>"
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
)