packages feed

extensioneer (empty) → 0.1.0.0

raw patch · 5 files changed

+460/−0 lines, 5 filesdep +Cabaldep +basedep +containers

Dependencies added: Cabal, base, containers, directory, hpack, mtl, optparse-applicative, yaml

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for extensioneer++## 0.1.0.0 -- 2022-04-28++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Markus Läll++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ extensioneer.cabal view
@@ -0,0 +1,82 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name:           extensioneer+version:        0.1.0.0+synopsis:       Inspect extensions in cabal and hpack files+description:    .+                extensioneer - Inspect extensions in cabal and hpack files+                .+                See readme for more: https://github.com/eyeinsky/extensioneer+category:       CLI+author:         Markus Läll+maintainer:     markus.l2ll@gmail.com+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    CHANGELOG.md++executable extensioneer+  main-is: Main.hs+  other-modules:+      PredefinedExtensionSets+      Paths_extensioneer+  hs-source-dirs:+      src+  default-extensions:+      Arrows+      BangPatterns+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveDataTypeable+      DeriveFunctor+      DeriveGeneric+      DerivingStrategies+      DerivingVia+      EmptyDataDecls+      ExtendedDefaultRules+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      ImportQualifiedPost+      KindSignatures+      LambdaCase+      MultiParamTypeClasses+      NamedFieldPuns+      NoImplicitPrelude+      NoMonomorphismRestriction+      OverloadedStrings+      PolyKinds+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      StandaloneKindSignatures+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeInType+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+  build-depends:+      Cabal+    , base >=4.11 && <5+    , containers+    , directory+    , hpack+    , mtl+    , optparse-applicative+    , yaml+  default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,264 @@+module Main where++import Prelude+import Data.Foldable+import Data.Map qualified as M+import Data.Maybe+import Data.List qualified as L+import Data.Either qualified as E+import Data.Kind+import Control.Monad.Except+import Control.Arrow++import Text.Printf+import System.Environment+import System.Directory+import Options.Applicative as Opts++-- | Hpack+import Hpack.Yaml as Hpack+import Hpack as Hpack+import Hpack.Config as Hpack++-- | Cabal+import Distribution.Types.BuildInfo as Cabal+import Language.Haskell.Extension as Cabal+import Distribution.Simple as Cabal hiding (Args)+import Distribution.PackageDescription as Cabal+import Distribution.PackageDescription.Parsec as Cabal+import Distribution.Types.GenericPackageDescription as Cabal+import Distribution.Verbosity as Cabal++import PredefinedExtensionSets+++-- * Types++data PackageFilePath+  = Cabal FilePath+  | Hpack FilePath+  deriving stock Eq++path :: PackageFilePath -> FilePath+path = \case+  Cabal p -> p+  Hpack p -> p++type FileExts = (PackageFilePath, [String])+type ExtFs = [(String, [String])]+type LabelExts = (String, [String])++-- * CLI arguments++data Args = Args+  { ghc2021     :: Bool+  , haskell2010 :: Bool+  , haskell98   :: Bool+  , paths       :: [FilePath]+  }++args :: Opts.Parser Args+args = Args+  <$> switch (long "ghc2021" <> help (allOf "GHC2021"))+  <*> switch (long "haskell2010" <> help (allOf "Haskell2010"))+  <*> switch (long "haskell98" <> help (allOf "Haskell98"))+  <*> some (argument str (metavar "paths to cabal or hpack files"))+  where+    allOf title = "Include all extensions from " <> title++opts :: ParserInfo Args+opts = info (args <**> helper)+  ( fullDesc+  <> header "extensioneer - Inspect extensions in cabal and hpack files" )++-- * Main++main :: IO ()+main = ioExcept $ do++  args <- liftIO $ execParser opts+  packageFilePaths <- resolvePaths $ paths args+  fileExtss :: [FileExts] <- getFilesExtensions packageFilePaths++  let+    labels = map path packageFilePaths :: [String]+    labels' =+        prependIf (ghc2021 args) "GHC2021"+      $ prependIf (haskell2010 args) "Haskell2010"+      $ prependIf (haskell98 args) "Haskell98"+      $ labels++    index = zip labels' [0..]++    labelExts = map (first path) fileExtss :: [LabelExts]+    labelExts' =+        prependIf (ghc2021 args) ("GHC2021", lang_GHC2021)+      $ prependIf (haskell2010 args) ("Haskell2010", lang_Haskell2010)+      $ prependIf (haskell98 args) ("Haskell98", lang_Haskell98)+      $ labelExts++  printSummaryTable index labelExts'++type C :: (Type -> Type) -> Constraint+type C m = (Monad m, MonadError String m, MonadIO m)++ioExcept :: ExceptT String IO () -> IO ()+ioExcept e = runExceptT e >>= \case+  Left e -> putStrLn $ "error: " <> e+  Right r -> pure ()++-- | Check if all paths exist, resolve them to cabal and hpack files+-- by extension+resolvePaths :: C m => [String] -> m [PackageFilePath]+resolvePaths args = do+  bools <- mapM (liftIO . doesFileExist) args+  let zip' = zip bools args+      (existing, nonExisting) = (map snd *** map snd) $ L.partition fst zip'+      (hpackFiles, existing') = L.partition (".yaml" `L.isSuffixOf`) existing+      (cabalFiles, existing'') = L.partition (".cabal" `L.isSuffixOf`) existing'++      f path | ".yaml" `L.isSuffixOf` path = Right (Hpack path)+             | ".cabal" `L.isSuffixOf` path = Right (Cabal path)+             | otherwise = Left path++      (unknown, hpackOrCabal) = E.partitionEithers $ map f args++  when (not $ null nonExisting) $ throwError+    $ "The following paths do not exist: \n"+    <> unlines (map ("- " <>) nonExisting)+  when (not $ null unknown) $ throwError+    $ "Don't recognize the file extension for following files: \n"+    <> unlines (map ("- " <>) existing'')++  return hpackOrCabal++printSummaryTable :: C m => [(String, Int)] -> [LabelExts] -> m ()+printSummaryTable index labelExts = do+  liftIO $ do+    forM_ index $ \(p, n) -> do+      putStrLn $ "# " <> show n <> " - " <> p+    putStrLn ""++    forM_ (merge labelExts) $ \(ext, ps) -> do+      let ns = catMaybes $ L.sort $ map (flip lookup index) ps+          strs = map f $ boolList 0 ns+            where+              f (n, b) = let s = show n+                in if b then s else replicate (length s) ' '+      printf "- %-28s # %s\n" ext $ L.intercalate " " strs++boolList :: Int -> [Int] -> [(Int, Bool)]+boolList n yss = case yss of+  (y : ys) -> let b = n == y+    in (n, b) : boolList (n + 1) (if b then ys else yss)+  _ -> []++merge :: [LabelExts] -> ExtFs+merge = pass+  where+    pass :: [LabelExts] -> ExtFs+    pass xs = case xs of+      _ : _+        | heads@(_:_) <- nextExts xs -> let+          ext = head $ L.sort heads+          files = map fst $ filter f xs+            where+              f ys = case ys of+                (p, y : _) -> y == ext+                _ -> False+          xs' = catMaybes $ map f xs+            where f = \case+                    a@(p, y : ys) -> Just $ if y == ext then (p, ys) else a+                    _ -> Nothing+          in (ext, files) : pass xs'+      _ -> []++    nextExts :: [LabelExts] -> [String]+    nextExts xs = catMaybes $ map (listToMaybe . snd) xs++getFilesExtensions :: C m => [PackageFilePath] -> m [FileExts]+getFilesExtensions fs = flip traverse fs $ \pfp -> case pfp of+  Hpack p -> (pfp,) <$> hpackGetExtensions p+  Cabal p -> (pfp,) <$> cabalGetExtensions p++-- * Hpack++hpackGetAllExtensions :: DecodeResult -> [String]+hpackGetAllExtensions result =+  let+    pkg = decodeResultPackage result+    lib = maybe [] pure $ packageLibrary pkg :: [Section Hpack.Library]+    ilib = packageInternalLibraries pkg :: M.Map String (Section Hpack.Library)+    es = packageExecutables pkg :: M.Map String (Section Hpack.Executable)+    ts = packageTests pkg :: M.Map String (Section Hpack.Executable)+    bs = packageBenchmarks pkg :: M.Map String (Section Hpack.Executable)++    mapExts a = map (sectionDefaultExtensions . snd) $ M.toList a++    all = map sectionDefaultExtensions lib+      <> mapExts ilib+      <> mapExts es+      <> mapExts ts+      <> mapExts bs++  in order $ concat all++hpackGetExtensions :: C m => FilePath -> m [String]+hpackGetExtensions path = do+  let opts = defaultDecodeOptions {decodeOptionsTarget = path }+  result :: DecodeResult <- liftIO (readPackageConfig opts)+    >>= either throwError pure+  return $ hpackGetAllExtensions result++-- * Cabal++-- | Gather all extensions from every corner of the cabal file.+--+-- https://hackage.haskell.org/package/Cabal/docs/Distribution-Types-GenericPackageDescription.html#t:GenericPackageDescription+cabalGetExtensionsIO :: FilePath -> IO [Extension]+cabalGetExtensionsIO path = do+  gpd <- liftIO $ readGenericPackageDescription silent path+  let+      libsExts = map (allExtensions . libBuildInfo)+      execsExts = map (allExtensions . buildInfo)++      pd = Cabal.packageDescription gpd+      lib, libs, exts :: [[Extension]]+      lib = maybe [] (pure . allExtensions . libBuildInfo) (library pd)+      libs = libsExts $ subLibraries pd+      exts = execsExts $ executables pd++      condDatas :: forall v c a . CondTree v c a -> [a]+      condDatas a = let+        branches = condTreeComponents a+        trues = condDatas =<< map condBranchIfTrue branches+        falses = condDatas =<< catMaybes (map condBranchIfFalse branches)+        in condTreeData a : (trues <> falses)++      lib_ = libsExts $ maybe [] condDatas (condLibrary gpd)+      libs_ = libsExts $ condDatas =<< map snd (condSubLibraries gpd)+      execs_ = execsExts $ condDatas =<< map snd (condExecutables gpd)++      all = concat $ lib <> libs <> exts <> lib_ <> libs_ <> execs_++  return all++cabalGetExtensions :: C m => FilePath -> m [String]+cabalGetExtensions path =+  fmap order . mapM ext2string =<< liftIO (cabalGetExtensionsIO path)++ext2string :: C m => Extension -> m String+ext2string = \case+  EnableExtension e -> return $ show e+  DisableExtension e -> return $ "No" <> show e+  UnknownExtension e -> throwError+    $ "ext2string: illegal extension '" <> e <> "'"++-- * Helpers++-- | Deduplicate and sort list+order :: Eq a => Ord a => [a] -> [a]+order = L.sort . L.nub++prependIf :: Bool -> a -> [a] -> [a]+prependIf b x xs = if b then x : xs else xs
+ src/PredefinedExtensionSets.hs view
@@ -0,0 +1,88 @@+module PredefinedExtensionSets where++import Prelude++-- * Languages+--+-- | Data from+-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/control.html+-- https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0380-ghc2021.rst++lang_GHC2021 :: [String]+lang_GHC2021 =+  [ "BangPatterns"+  , "BinaryLiterals"+  , "ConstrainedClassMethods"+  , "ConstraintKinds"+  , "DeriveDataTypeable"+  , "DeriveFoldable"+  , "DeriveFunctor"+  , "DeriveGeneric"+  , "DeriveLift"+  , "DeriveTraversable"+  , "DoAndIfThenElse"+  , "EmptyCase"+  , "EmptyDataDecls"+  , "EmptyDataDeriving"+  , "ExistentialQuantification"+  , "ExplicitForAll"+  , "FieldSelectors"+  , "FlexibleContexts"+  , "FlexibleInstances"+  , "ForeignFunctionInterface"+  , "GADTSyntax"+  , "GeneralisedNewtypeDeriving"+  , "HexFloatLiterals"+  , "ImplicitPrelude"+  , "ImportQualifiedPost"+  , "InstanceSigs"+  , "KindSignatures"+  , "MonomorphismRestriction"+  , "MultiParamTypeClasses"+  , "NamedFieldPuns"+  , "NamedWildCards"+  , "NumericUnderscores"+  , "PatternGuards"+  , "PolyKinds"+  , "PostfixOperators"+  , "RankNTypes"+  , "RelaxedPolyRec"+  , "ScopedTypeVariables"+  , "StandaloneDeriving"+  , "StandaloneKindSignatures"+  , "StarIsType"+  , "TraditionalRecordSyntax"+  , "TupleSections"+  , "TypeApplications"+  , "TypeOperators"+  , "TypeSynonymInstances"+  ]++lang_Haskell2010 :: [String]+lang_Haskell2010 =+  [ "CUSKs"+  , "DatatypeContexts"+  , "DoAndIfThenElse"+  , "EmptyDataDecls"+  , "FieldSelectors"+  , "ForeignFunctionInterface"+  , "ImplicitPrelude"+  , "MonomorphismRestriction"+  , "PatternGuards"+  , "RelaxedPolyRec"+  , "StarIsType"+  , "TraditionalRecordSyntax"+  ]++lang_Haskell98 :: [String]+lang_Haskell98 =+  [ "CUSKs"+  , "DatatypeContexts"+  , "FieldSelectors"+  , "ImplicitPrelude"+  , "MonomorphismRestriction"+  , "NPlusKPatterns"+  , "NondecreasingIndentation"+  , "StarIsType"+  , "TraditionalRecordSyntax"+  ]