Aura2 Package Test

Package.hs

{-# LANGUAGE RebindableSyntax, NoMonomorphismRestriction, ConstraintKinds #-}
{-# LANGUAGE NamedFieldPuns #-}

module Aura.Package
where

import YAPP

import Data.Rose --(Rose (rootLabel, getSubBush))
import qualified Data.Map.Lazy as M

data Package = Package {
      _name :: String
    , _version :: SemanticVersion
    , _conflictable :: Bool
    , _install :: IO (Either String String)
    }

newtype SemanticVersion = SemanticVersion
    {getSemanticVersion :: (Integer, Integer, Integer)}
    deriving (Eq, Ord, Show, Read)

instance Show Package where
    showsPrec d (Package {_name, _version, _conflictable}) =
        showParen (d > app_prec) $
        showString "Package { _name = " . showsPrec (app_prec + 1) _name .
        showString ", _version = " . showsPrec (app_prec + 1) _version .
        showString ", _conflictable = " .
            showsPrec (app_prec + 1) _conflictable .
        showString ", _install = <function>" .
        showString "}"

        where app_prec = 10

gatherConflictable :: (Foldable t, ApplicSMonoid u Package) =>
                      t Package -> u Package
gatherConflictable = foldl'
    (\conPkgs pkg -> if _conflictable pkg then return pkg ++ conPkgs
                                          else conPkgs)
    mempty

findConflicting :: (Foldable t, ApplicSemigroup u Package, Foldable u) =>
                   t Package -> M.Map String (u Package)
findConflicting = pruneSingletons . foldl'
    (\conPkgs pkg -> M.insertWith (++) (_name pkg) (return pkg) conPkgs)
    mempty

pruneSingletons :: Foldable t => M.Map k (t a) -> M.Map k (t a)
pruneSingletons = M.filter (not . (== 1) . length)

gatherConflicting :: (Foldable t, ApplicSemigroup u Package, Foldable u) =>
                     t Package -> M.Map String (u Package)
gatherConflicting pkgs = findConflicting (gatherConflictable pkgs :: [] Package)