{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Hpack.Syntax.Dependencies (
  Dependencies(..)
, DependencyInfo(..)
, parseDependency
) where

import           Imports

import qualified Control.Monad.Fail as Fail
import qualified Data.Text as T
import qualified Distribution.Package as D
import qualified Distribution.Types.LibraryName as D
import           Distribution.Pretty (prettyShow)
import           Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import           GHC.Exts

#if MIN_VERSION_Cabal(3,4,0)
import qualified Distribution.Compat.NonEmptySet as DependencySet
#else
import qualified Data.Set as DependencySet
#endif

import           Data.Aeson.Config.FromValue
import           Data.Aeson.Config.Types

import           Hpack.Syntax.DependencyVersion
import           Hpack.Syntax.ParseDependencies

newtype Dependencies = Dependencies {
  Dependencies -> Map String DependencyInfo
unDependencies :: Map String DependencyInfo
} deriving (Dependencies -> Dependencies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependencies -> Dependencies -> Bool
$c/= :: Dependencies -> Dependencies -> Bool
== :: Dependencies -> Dependencies -> Bool
$c== :: Dependencies -> Dependencies -> Bool
Eq, Int -> Dependencies -> ShowS
[Dependencies] -> ShowS
Dependencies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependencies] -> ShowS
$cshowList :: [Dependencies] -> ShowS
show :: Dependencies -> String
$cshow :: Dependencies -> String
showsPrec :: Int -> Dependencies -> ShowS
$cshowsPrec :: Int -> Dependencies -> ShowS
Show, NonEmpty Dependencies -> Dependencies
Dependencies -> Dependencies -> Dependencies
forall b. Integral b => b -> Dependencies -> Dependencies
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Dependencies -> Dependencies
$cstimes :: forall b. Integral b => b -> Dependencies -> Dependencies
sconcat :: NonEmpty Dependencies -> Dependencies
$csconcat :: NonEmpty Dependencies -> Dependencies
<> :: Dependencies -> Dependencies -> Dependencies
$c<> :: Dependencies -> Dependencies -> Dependencies
Semigroup, Semigroup Dependencies
Dependencies
[Dependencies] -> Dependencies
Dependencies -> Dependencies -> Dependencies
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Dependencies] -> Dependencies
$cmconcat :: [Dependencies] -> Dependencies
mappend :: Dependencies -> Dependencies -> Dependencies
$cmappend :: Dependencies -> Dependencies -> Dependencies
mempty :: Dependencies
$cmempty :: Dependencies
Monoid)

instance IsList Dependencies where
  type Item Dependencies = (String, DependencyInfo)
  fromList :: [Item Dependencies] -> Dependencies
fromList = Map String DependencyInfo -> Dependencies
Dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  toList :: Dependencies -> [Item Dependencies]
toList = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map String DependencyInfo
unDependencies

instance FromValue Dependencies where
  fromValue :: Value -> Parser Dependencies
fromValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map String DependencyInfo -> Dependencies
Dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Parse k v -> Value -> Parser [(k, v)]
parseDependencies Parse String DependencyInfo
parse
    where
      parse :: Parse String DependencyInfo
      parse :: Parse String DependencyInfo
parse = Parse {
        parseString :: Text -> Parser (String, DependencyInfo)
parseString = \ Text
input -> do
          (String
name, DependencyVersion
version) <- forall (m :: * -> *).
MonadFail m =>
String -> Text -> m (String, DependencyVersion)
parseDependency String
"dependency" Text
input
          forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [String] -> DependencyVersion -> DependencyInfo
DependencyInfo [] DependencyVersion
version)
      , parseListItem :: Object -> Parser DependencyInfo
parseListItem = Object -> Parser DependencyInfo
objectDependencyInfo
      , parseDictItem :: Value -> Parser DependencyInfo
parseDictItem = Value -> Parser DependencyInfo
dependencyInfo
      , parseName :: Text -> String
parseName = Text -> String
T.unpack
      }

data DependencyInfo = DependencyInfo {
  DependencyInfo -> [String]
dependencyInfoMixins :: [String]
, DependencyInfo -> DependencyVersion
dependencyInfoVersion :: DependencyVersion
} deriving (DependencyInfo -> DependencyInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyInfo -> DependencyInfo -> Bool
$c/= :: DependencyInfo -> DependencyInfo -> Bool
== :: DependencyInfo -> DependencyInfo -> Bool
$c== :: DependencyInfo -> DependencyInfo -> Bool
Eq, Eq DependencyInfo
DependencyInfo -> DependencyInfo -> Bool
DependencyInfo -> DependencyInfo -> Ordering
DependencyInfo -> DependencyInfo -> DependencyInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DependencyInfo -> DependencyInfo -> DependencyInfo
$cmin :: DependencyInfo -> DependencyInfo -> DependencyInfo
max :: DependencyInfo -> DependencyInfo -> DependencyInfo
$cmax :: DependencyInfo -> DependencyInfo -> DependencyInfo
>= :: DependencyInfo -> DependencyInfo -> Bool
$c>= :: DependencyInfo -> DependencyInfo -> Bool
> :: DependencyInfo -> DependencyInfo -> Bool
$c> :: DependencyInfo -> DependencyInfo -> Bool
<= :: DependencyInfo -> DependencyInfo -> Bool
$c<= :: DependencyInfo -> DependencyInfo -> Bool
< :: DependencyInfo -> DependencyInfo -> Bool
$c< :: DependencyInfo -> DependencyInfo -> Bool
compare :: DependencyInfo -> DependencyInfo -> Ordering
$ccompare :: DependencyInfo -> DependencyInfo -> Ordering
Ord, Int -> DependencyInfo -> ShowS
[DependencyInfo] -> ShowS
DependencyInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DependencyInfo] -> ShowS
$cshowList :: [DependencyInfo] -> ShowS
show :: DependencyInfo -> String
$cshow :: DependencyInfo -> String
showsPrec :: Int -> DependencyInfo -> ShowS
$cshowsPrec :: Int -> DependencyInfo -> ShowS
Show)

addMixins :: Object -> DependencyVersion -> Parser DependencyInfo
addMixins :: Object -> DependencyVersion -> Parser DependencyInfo
addMixins Object
o DependencyVersion
version = do
  Maybe (List String)
mixinsMay <- Object
o forall a. FromValue a => Object -> Key -> Parser (Maybe a)
.:? Key
"mixin"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> DependencyVersion -> DependencyInfo
DependencyInfo (forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
mixinsMay) DependencyVersion
version

objectDependencyInfo :: Object -> Parser DependencyInfo
objectDependencyInfo :: Object -> Parser DependencyInfo
objectDependencyInfo Object
o = Object -> Parser DependencyVersion
objectDependency Object
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> DependencyVersion -> Parser DependencyInfo
addMixins Object
o

dependencyInfo :: Value -> Parser DependencyInfo
dependencyInfo :: Value -> Parser DependencyInfo
dependencyInfo = forall a.
(DependencyVersion -> a)
-> (Object -> DependencyVersion -> Parser a) -> Value -> Parser a
withDependencyVersion ([String] -> DependencyVersion -> DependencyInfo
DependencyInfo []) Object -> DependencyVersion -> Parser DependencyInfo
addMixins

parseDependency :: Fail.MonadFail m => String -> Text -> m (String, DependencyVersion)
parseDependency :: forall (m :: * -> *).
MonadFail m =>
String -> Text -> m (String, DependencyVersion)
parseDependency String
subject = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dependency -> (String, DependencyVersion)
fromCabal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadFail m, Parsec a) =>
String -> String -> m a
cabalParse String
subject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  where
    fromCabal :: D.Dependency -> (String, DependencyVersion)
    fromCabal :: Dependency -> (String, DependencyVersion)
fromCabal Dependency
d = (PackageName -> [LibraryName] -> String
toName (Dependency -> PackageName
D.depPkgName Dependency
d) (forall a. NonEmptySet a -> [a]
DependencySet.toList forall a b. (a -> b) -> a -> b
$ Dependency -> NonEmptySet LibraryName
D.depLibraries Dependency
d), Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionConstraint
versionConstraintFromCabal forall a b. (a -> b) -> a -> b
$ Dependency -> VersionRange
D.depVerRange Dependency
d)

    toName :: D.PackageName -> [D.LibraryName] -> String
    toName :: PackageName -> [LibraryName] -> String
toName PackageName
package [LibraryName]
components = forall a. Pretty a => a -> String
prettyShow PackageName
package forall a. Semigroup a => a -> a -> a
<> case [LibraryName]
components of
      [LibraryName
D.LMainLibName] -> String
""
      [D.LSubLibName UnqualComponentName
lib] -> String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> String
prettyShow UnqualComponentName
lib
      [LibraryName]
xs -> String
":{" forall a. Semigroup a => a -> a -> a
<> (forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow [UnqualComponentName
name | D.LSubLibName UnqualComponentName
name <- [LibraryName]
xs]) forall a. Semigroup a => a -> a -> a
<> String
"}"