Add licensor library

Main.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Main
@@ -7,58 +5,23 @@ module Main
   )
   where
 
+-- licensor
+import Licensor
+
 -- 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
-
 
 -- |
 --
@@ -106,83 +69,3 @@ main = do
                 <> 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)

licensor.cabal

@@ -14,9 +14,11 @@ extra-source-files:  README.md
 build-type:          Simple
 cabal-version:       >= 1.10
 
-executable licensor
-  main-is:
-      Main.hs
+library
+  hs-source-dirs:
+      src
+  exposed-modules:
+      Licensor
   build-depends:
       base >= 4.8 && < 5.0
     , Cabal >= 1.22 && < 1.25
@@ -26,6 +28,19 @@ executable licensor
     , process
   default-language:
       Haskell2010
+  ghc-options:
+      -Wall
+
+executable licensor
+  main-is:
+      Main.hs
+  build-depends:
+      base >= 4.8 && < 5.0
+    , Cabal >= 1.22 && < 1.25
+    , containers
+    , licensor
+  default-language:
+      Haskell2010
   ghc-options:
       -Wall -threaded -rtsopts -with-rtsopts=-N
 

src/Licensor.hs

@@ -0,0 +1,153 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Licensor
+  ( LiLicense(..)
+  , LiPackage(..)
+  , getDependencies
+  , getPackage
+  , orderPackagesByLicense
+  )
+  where
+
+-- base
+import Data.Monoid ((<>))
+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 LiLicense = LiLicense { getLicense :: License }
+  deriving (Eq, Read, Show, Text)
+
+
+-- |
+--
+--
+
+instance Ord LiLicense where
+  compare =
+    comparing display
+
+
+-- |
+--
+--
+
+data LiPackage =
+  LiPackage
+    { liPackageId :: PackageIdentifier
+    , liPackageDependencies :: Set LiPackage
+    , liPackageLicense :: License
+    }
+
+
+-- |
+--
+--
+
+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 LiLicense
+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 (LiLicense license)
+
+
+-- |
+--
+--
+
+orderPackagesByLicense
+  :: PackageIdentifier
+  -> Set PackageIdentifier
+  -> IO (Map LiLicense (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)