Play around with Haskell

Main.hs

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Applicative        ((<$>), (<*>))
import           Control.Monad              (mzero)
import           Data.Aeson
import           Data.Aeson.Types           (emptyObject)
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.HashMap.Strict        as H
import           Data.List                  (sortBy)
import           Data.Maybe                 (fromJust)
import qualified Data.Text                  as T
import qualified Data.Vector                as V
import           GHC.Generics
import           System.Process             (readProcess)


type Counter = H.HashMap T.Text Int
type Dep = (T.Text, T.Text)

data RawDep = RawDep T.Text T.Text [RawDep] deriving (Show, Eq)

instance FromJSON RawDep where
  parseJSON (Object o) =
    RawDep  <$>
    (.:?) o "name" .!= "" <*>
    (.:)  o "version"     <*>
    (pds =<< (o .:? "dependencies" .!= emptyObject))
    where
      pds = withObject "dependencies must be an object" $ mapM parseDep . H.toList
      parseDep (n, dep) = newName n <$> parseJSON dep
      newName n (RawDep _ v ds) = RawDep n v ds

  parseJSON _ = mzero

data Version = Version
  { version :: T.Text
  , count   :: Int
  } deriving (Show, Eq, Generic)

data Dependency = Dependency
  { dependency   :: T.Text
  , versions     :: V.Vector Version
  , diversity    :: Int
  , duplications :: Int
  } deriving (Show, Eq, Generic)

instance ToJSON Version
instance ToJSON Dependency

traverse root@(RawDep _ _ deps) = raw2dep root : concatMap traverse deps
  where raw2dep (RawDep n v _) = (n, v)

counts = go H.empty H.empty
  where go uniq global []          = (uniq, global)
        go uniq global ((n, v):ds) =
          let uniq'   = H.insertWith (+) n 1 uniq
              global' = H.insertWith (\_ -> H.insertWith (+) v 1) n (H.singleton v 1) global
          in go uniq' global' ds

mostCommon = V.fromList . sortBy compares . H.toList
  where
    compares (n1, v1) (n2,v2) = case compare v2 v1 of
      EQ -> compare n1 n2
      x  -> x

combine (uniq, global) =
  let uniqs = mostCommon uniq
      m (n, _) = makeDependency n (global H.! n)
  in  fmap m uniqs

makeDependency name vers =
  let vs = makeVersion vers
  in Dependency name vs (V.length vs) (duplicates vs)
  where
    makeVersion = fmap (uncurry Version) . mostCommon
    duplicates  = V.sum . fmap count

chain = encode . combine . counts . traverse . fromJust . decode . BL.pack

call = readProcess "npm" ["list", "--json"] []

main = fmap chain call >>= BL.putStrLn

npm-madness-h.cabal

-- Initial npm-madness-h.cabal generated by cabal init.  For further
-- documentation, see http://haskell.org/cabal/users-guide/

name:                npm-madness-h
version:             0.1.0.0
author:              Paul Horn
maintainer:          knutwalker@gmail.com
build-type:          Simple
cabal-version:       >=1.10

executable npm-madness-h
  main-is:             Main.hs
  build-depends:       base >=4.7 && <4.8, aeson, bytestring, unordered-containers, text, vector, process
  default-language:    Haskell2010

Setup.hs

import Distribution.Simple
main = defaultMain