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
This commit is contained in:
Profpatsch 2023-04-08 12:59:01 +02:00 committed by clbot
parent 6edc2182d1
commit 5e400b5b24
4 changed files with 59 additions and 37 deletions

View file

@ -1,72 +1,76 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
import qualified Text.HTML.TagSoup as Tag
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.List as List
import Data.Maybe
import Text.Nicify
import qualified Text.Read as Read
import Numeric.Natural
import Data.Either
import qualified Data.ByteString as ByteString
import qualified Data.Text.Encoding
parseNat :: Text.Text -> Maybe Natural module Main where
parseNat = Read.readMaybe . Text.unpack
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 :: Show a => a -> IO ()
printNice = putStrLn . nicify . show printNice = putStrLn . nicify . show
type Tag = Tag.Tag Text.Text type Tag = Tag.Tag Text
main = do main = do
reverseHtml <- readStdinUtf8 reverseHtml <- readStdinUtf8
printNice $ List.sortOn snd $ packagesAndReverseDeps reverseHtml printNice $ List.sortOn snd $ packagesAndReverseDeps reverseHtml
where where
readStdinUtf8 = Data.Text.Encoding.decodeUtf8 <$> ByteString.getContents readStdinUtf8 = bytesToTextUtf8Lenient <$> ByteString.getContents
-- | reads the table provided by https://packdeps.haskellers.com/reverse -- | reads the table provided by https://packdeps.haskellers.com/reverse
-- figuring out all sections (starting with the link to the package name), -- figuring out all sections (starting with the link to the package name),
-- then figuring out the name of the package and the first column, -- then figuring out the name of the package and the first column,
-- which is the number of reverse dependencies of the package -- which is the number of reverse dependencies of the package
packagesAndReverseDeps :: Text -> [(Text, Natural)]
packagesAndReverseDeps reverseHtml = do packagesAndReverseDeps reverseHtml = do
let tags = Tag.parseTags reverseHtml let tags = Tag.parseTags reverseHtml
let sections = Tag.partitions (isJust . reverseLink) tags let sections = Tag.partitions (isJust . reverseLink) tags
let sectionNames = map (fromJust . reverseLink . head) sections let sectionName [] = "<unknown section>"
sectionName (sect : _) = sect & reverseLink & fromMaybe "<unknown section>"
let sectionNames = map sectionName sections
mapMaybe mapMaybe
(\(name :: Text.Text, sect) -> do ( \(name :: Text, sect) -> do
reverseDeps <- firstNaturalNumber sect reverseDeps <- firstNaturalNumber sect
pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text.Text, Natural)) pure (sectionPackageName name sect, reverseDeps) :: Maybe (Text, Natural)
)
$ zip sectionNames sections $ zip sectionNames sections
where where
reverseLink = \case reverseLink = \case
Tag.TagOpen "a" attrs -> mapFind attrReverseLink attrs Tag.TagOpen "a" attrs -> findMaybe attrReverseLink attrs
_ -> Nothing _ -> Nothing
attrReverseLink = \case attrReverseLink = \case
("href", lnk) -> if ("href", lnk) ->
if
| "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk | "packdeps.haskellers.com/reverse/" `Text.isInfixOf` lnk -> Just lnk
| otherwise -> Nothing | otherwise -> Nothing
_ -> Nothing _ -> Nothing
sectionPackageName :: Text -> [Tag] -> Text sectionPackageName :: Text -> [Tag] -> Text
sectionPackageName sectionName = \case sectionPackageName sectionName = \case
(_: Tag.TagText name : _) -> name (_ : Tag.TagText name : _) -> name
(_: el : _) -> sectionName (_ : el : _) -> sectionName
xs -> sectionName xs -> sectionName
firstNaturalNumber :: [Tag] -> Maybe Natural firstNaturalNumber :: [Tag] -> Maybe Natural
firstNaturalNumber = firstNaturalNumber =
mapFind (\case findMaybe
( \case
Tag.TagText t -> parseNat t Tag.TagText t -> parseNat t
_ -> Nothing) _ -> Nothing
)
mapFind :: (a -> Maybe b) -> [a] -> Maybe b
mapFind f xs = fromJust . f <$> List.find (isJust . f) xs

View file

@ -19,12 +19,13 @@ let
rev-hs = pkgs.writers.writeHaskell "revers-haskell-deps-hs" rev-hs = pkgs.writers.writeHaskell "revers-haskell-deps-hs"
{ {
libraries = [ libraries = [
depot.users.Profpatsch.my-prelude
pkgs.haskellPackages.nicify-lib pkgs.haskellPackages.nicify-lib
pkgs.haskellPackages.tagsoup pkgs.haskellPackages.tagsoup
]; ];
} }
./reverse-haskell-deps.hs; ./ReverseHaskellDeps.hs;
in in

View file

@ -0,0 +1,16 @@
cabal-version: 2.4
name: reverse-haskell-deps
version: 0.1.0.0
author: Profpatsch
maintainer: mail@profpatsch.de
library
exposed-modules: ReverseHaskellDeps.hs
build-depends:
base >=4.15 && <5,
my-prelude,
tagsoup,
nicify-lib
default-language: Haskell2010

View file

@ -29,6 +29,7 @@ pkgs.mkShell {
h.nonempty-containers h.nonempty-containers
h.deriving-compat h.deriving-compat
h.unix h.unix
h.tagsoup
h.attoparsec h.attoparsec
h.iCalendar h.iCalendar
h.case-insensitive h.case-insensitive