diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..b171903 --- /dev/null +++ b/Main.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} + +module Main + ( main + ) + where + +-- base +import Control.Monad +import Data.List +import Data.Monoid ((<>)) +import qualified System.Exit as Exit +import System.IO + +-- Cabal +import Distribution.License +import Distribution.Package +import Distribution.PackageDescription +import Distribution.PackageDescription.Parse +import Distribution.Simple.Utils +import Distribution.Text +import Distribution.Verbosity + +-- containers +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Set (Set) +import qualified Data.Set as Set + +-- directory +import System.Directory + +-- HTTP +import Network.HTTP + ( getRequest + , getResponseBody + , simpleHTTP + ) + +-- process +import System.Process + + +-- | +-- +-- + +newtype License' = License' { _getLicense :: License } + deriving (Eq, Read, Show, Text) + + +-- | +-- +-- + +instance Ord License' where + compare = + comparing display + + +-- | +-- +-- + +main :: IO () +main = do + maybePackage <- getPackage + + pid <- + case maybePackage of + Nothing -> + Exit.die "Error: No Cabal file found." + + Just PackageDescription{..} -> do + putStrLn $ + "Package: " + <> display package + <> " (" + <> "License: " + <> display license + <> ")" + return package + + maybeDependencies <- getDependencies + + case maybeDependencies of + Nothing -> + Exit.die "Error: ..." + + Just dependencies -> do + dependenciesByLicense <- + fmap (Set.map display) <$> orderPackagesByLicense pid dependencies + + forM_ (Map.keys dependenciesByLicense) $ + \license -> + let + n = dependenciesByLicense Map.! license + in do + putStrLn "-----" + putStrLn $ + show (Set.size n) + <> (if Set.size n == 1 then " package " else " packages ") + <> "licensed under " + <> display license + <> ": " + <> intercalate ", " (Set.toList n) + + +-- | +-- +-- + +getPackage :: IO (Maybe PackageDescription) +getPackage = do + currentDirectory <- getCurrentDirectory + fmap getPackageDescription <$> findPackageDesc currentDirectory + >>= either (const (return Nothing)) (fmap Just) + + +-- | +-- +-- + +getPackageDescription :: FilePath -> IO PackageDescription +getPackageDescription = + fmap packageDescription . readPackageDescription silent + + +-- | +-- +-- + +getDependencies :: IO (Maybe (Set PackageIdentifier)) +getDependencies = + fmap Set.fromList . sequence . fmap simpleParse . lines + <$> readProcess "stack" ["list-dependencies", "--separator", "-"] "" + + +-- | +-- +-- + +getPackageLicense :: PackageIdentifier -> IO License' +getPackageLicense p@PackageIdentifier{..} = do + let + url = + "http://hackage.haskell.org/package/" + <> display p + <> "/" + <> unPackageName pkgName + <> ".cabal" + pd <- simpleHTTP (getRequest url) >>= getResponseBody + (file, handle) <- openTempFile "/tmp" "licensor" + hClose handle + writeFile file pd + PackageDescription{license} <- getPackageDescription file + hClose handle + removeFile file + return (License' license) + + +-- | +-- +-- + +orderPackagesByLicense + :: PackageIdentifier + -> Set PackageIdentifier + -> IO (Map License' (Set PackageIdentifier)) +orderPackagesByLicense p = + let + insertPackage package orderedPackages' = do + license <- getPackageLicense package + orderedPackages <- orderedPackages' + return $ + if p == package + then + orderedPackages + else + Map.insertWith + Set.union + license + (Set.singleton package) + orderedPackages + in + foldr insertPackage (pure mempty) diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..93cfa1f --- /dev/null +++ b/Setup.hs @@ -0,0 +1,11 @@ +module Main + ( main + ) + where + +import Distribution.Simple (defaultMain) + + +main :: IO () +main = + defaultMain diff --git a/licensor.cabal b/licensor.cabal new file mode 100644 index 0000000..e5eb656 --- /dev/null +++ b/licensor.cabal @@ -0,0 +1,34 @@ +name: licensor +version: 0.1.0 +synopsis: A license compatibility helper +description: A license compatibility helper. +homepage: https://github.com/jpvillaisaza/licensor +bug-reports: https://github.com/jpvillaisaza/licensor/issues +license: MIT +license-file: LICENSE.md +author: Juan Pedro Villa Isaza +maintainer: Juan Pedro Villa Isaza +copyright: 2016 Juan Pedro Villa Isaza +category: Distribution +extra-source-files: README.md +build-type: Simple +cabal-version: >= 1.10 + +executable licensor + main-is: + Main.hs + build-depends: + base >= 4.8 && < 5.0 + , Cabal >= 1.22 && < 1.25 + , containers + , directory + , HTTP >= 4000.3 && < 4000.4 + , process + default-language: + Haskell2010 + ghc-options: + -Wall -threaded -rtsopts -with-rtsopts=-N + +source-repository head + type: git + location: https://github.com/jpvillaisaza/licensor diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..3334532 --- /dev/null +++ b/stack.yaml @@ -0,0 +1 @@ +resolver: lts-6.11