{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}
module Hpack.Syntax.BuildTools (
  BuildTools(..)
, ParseBuildTool(..)
, SystemBuildTools(..)
) where

import           Imports

import qualified Control.Monad.Fail as Fail
import qualified Data.Text as T
import qualified Distribution.Package as D
import           Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map

import qualified Distribution.Types.ExeDependency as D
import qualified Distribution.Types.UnqualComponentName as D
import qualified Distribution.Types.LegacyExeDependency as D

import           Data.Aeson.Config.FromValue

import           Hpack.Syntax.DependencyVersion
import           Hpack.Syntax.Dependencies (parseDependency)

import           Hpack.Syntax.ParseDependencies

data ParseBuildTool = QualifiedBuildTool String String | UnqualifiedBuildTool String
  deriving (Int -> ParseBuildTool -> ShowS
[ParseBuildTool] -> ShowS
ParseBuildTool -> String
(Int -> ParseBuildTool -> ShowS)
-> (ParseBuildTool -> String)
-> ([ParseBuildTool] -> ShowS)
-> Show ParseBuildTool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseBuildTool] -> ShowS
$cshowList :: [ParseBuildTool] -> ShowS
show :: ParseBuildTool -> String
$cshow :: ParseBuildTool -> String
showsPrec :: Int -> ParseBuildTool -> ShowS
$cshowsPrec :: Int -> ParseBuildTool -> ShowS
Show, ParseBuildTool -> ParseBuildTool -> Bool
(ParseBuildTool -> ParseBuildTool -> Bool)
-> (ParseBuildTool -> ParseBuildTool -> Bool) -> Eq ParseBuildTool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseBuildTool -> ParseBuildTool -> Bool
$c/= :: ParseBuildTool -> ParseBuildTool -> Bool
== :: ParseBuildTool -> ParseBuildTool -> Bool
$c== :: ParseBuildTool -> ParseBuildTool -> Bool
Eq)

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

instance FromValue BuildTools where
  fromValue :: Value -> Parser BuildTools
fromValue = ([(ParseBuildTool, DependencyVersion)] -> BuildTools)
-> Parser [(ParseBuildTool, DependencyVersion)]
-> Parser BuildTools
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParseBuildTool, DependencyVersion)] -> BuildTools
BuildTools (Parser [(ParseBuildTool, DependencyVersion)] -> Parser BuildTools)
-> (Value -> Parser [(ParseBuildTool, DependencyVersion)])
-> Value
-> Parser BuildTools
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse ParseBuildTool DependencyVersion
-> Value -> Parser [(ParseBuildTool, DependencyVersion)]
forall k v. Parse k v -> Value -> Parser [(k, v)]
parseDependencies Parse ParseBuildTool DependencyVersion
parse
    where
      parse :: Parse ParseBuildTool DependencyVersion
      parse :: Parse ParseBuildTool DependencyVersion
parse = Parse :: forall k v.
(Text -> Parser (k, v))
-> (Object -> Parser v)
-> (Value -> Parser v)
-> (Text -> k)
-> Parse k v
Parse {
        parseString :: Text -> Parser (ParseBuildTool, DependencyVersion)
parseString = Text -> Parser (ParseBuildTool, DependencyVersion)
buildToolFromString
      , parseListItem :: Object -> Parser DependencyVersion
parseListItem = Object -> Parser DependencyVersion
objectDependency
      , parseDictItem :: Value -> Parser DependencyVersion
parseDictItem = Value -> Parser DependencyVersion
dependencyVersion
      , parseName :: Text -> ParseBuildTool
parseName = Text -> ParseBuildTool
nameToBuildTool
      }

      nameToBuildTool :: Text -> ParseBuildTool
      nameToBuildTool :: Text -> ParseBuildTool
nameToBuildTool (Text -> String
T.unpack -> String
name) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
name of
        (String
executable, String
"") -> String -> ParseBuildTool
UnqualifiedBuildTool String
executable
        (String
package, String
executable) -> String -> String -> ParseBuildTool
QualifiedBuildTool String
package (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
executable)

      buildToolFromString :: Text -> Parser (ParseBuildTool, DependencyVersion)
      buildToolFromString :: Text -> Parser (ParseBuildTool, DependencyVersion)
buildToolFromString Text
s = Text -> Parser (ParseBuildTool, DependencyVersion)
forall (m :: * -> *).
MonadFail m =>
Text -> m (ParseBuildTool, DependencyVersion)
parseQualifiedBuildTool Text
s Parser (ParseBuildTool, DependencyVersion)
-> Parser (ParseBuildTool, DependencyVersion)
-> Parser (ParseBuildTool, DependencyVersion)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser (ParseBuildTool, DependencyVersion)
forall (m :: * -> *).
MonadFail m =>
Text -> m (ParseBuildTool, DependencyVersion)
parseUnqualifiedBuildTool Text
s

      parseQualifiedBuildTool :: Fail.MonadFail m => Text -> m (ParseBuildTool, DependencyVersion)
      parseQualifiedBuildTool :: Text -> m (ParseBuildTool, DependencyVersion)
parseQualifiedBuildTool = (ExeDependency -> (ParseBuildTool, DependencyVersion))
-> m ExeDependency -> m (ParseBuildTool, DependencyVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExeDependency -> (ParseBuildTool, DependencyVersion)
fromCabal (m ExeDependency -> m (ParseBuildTool, DependencyVersion))
-> (Text -> m ExeDependency)
-> Text
-> m (ParseBuildTool, DependencyVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> m ExeDependency
forall (m :: * -> *) a.
(MonadFail m, Parsec a) =>
String -> String -> m a
cabalParse String
"build tool" (String -> m ExeDependency)
-> (Text -> String) -> Text -> m ExeDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
        where
          fromCabal :: D.ExeDependency -> (ParseBuildTool, DependencyVersion)
          fromCabal :: ExeDependency -> (ParseBuildTool, DependencyVersion)
fromCabal (D.ExeDependency PackageName
package UnqualComponentName
executable VersionRange
version) = (
              String -> String -> ParseBuildTool
QualifiedBuildTool (PackageName -> String
D.unPackageName PackageName
package) (UnqualComponentName -> String
D.unUnqualComponentName UnqualComponentName
executable)
            , Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion Maybe SourceDependency
forall a. Maybe a
Nothing (VersionConstraint -> DependencyVersion)
-> VersionConstraint -> DependencyVersion
forall a b. (a -> b) -> a -> b
$ VersionRange -> VersionConstraint
versionConstraintFromCabal VersionRange
version
            )

      parseUnqualifiedBuildTool :: Fail.MonadFail m => Text -> m (ParseBuildTool, DependencyVersion)
      parseUnqualifiedBuildTool :: Text -> m (ParseBuildTool, DependencyVersion)
parseUnqualifiedBuildTool = ((String, DependencyVersion)
 -> (ParseBuildTool, DependencyVersion))
-> m (String, DependencyVersion)
-> m (ParseBuildTool, DependencyVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> ParseBuildTool)
-> (String, DependencyVersion)
-> (ParseBuildTool, DependencyVersion)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ParseBuildTool
UnqualifiedBuildTool) (m (String, DependencyVersion)
 -> m (ParseBuildTool, DependencyVersion))
-> (Text -> m (String, DependencyVersion))
-> Text
-> m (ParseBuildTool, DependencyVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> m (String, DependencyVersion)
forall (m :: * -> *).
MonadFail m =>
String -> Text -> m (String, DependencyVersion)
parseDependency String
"build tool"

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

instance FromValue SystemBuildTools where
  fromValue :: Value -> Parser SystemBuildTools
fromValue = ([(String, VersionConstraint)] -> SystemBuildTools)
-> Parser [(String, VersionConstraint)] -> Parser SystemBuildTools
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map String VersionConstraint -> SystemBuildTools
SystemBuildTools (Map String VersionConstraint -> SystemBuildTools)
-> ([(String, VersionConstraint)] -> Map String VersionConstraint)
-> [(String, VersionConstraint)]
-> SystemBuildTools
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, VersionConstraint)] -> Map String VersionConstraint
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) (Parser [(String, VersionConstraint)] -> Parser SystemBuildTools)
-> (Value -> Parser [(String, VersionConstraint)])
-> Value
-> Parser SystemBuildTools
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parse String VersionConstraint
-> Value -> Parser [(String, VersionConstraint)]
forall k v. Parse k v -> Value -> Parser [(k, v)]
parseDependencies Parse String VersionConstraint
parse
    where
      parse :: Parse String VersionConstraint
      parse :: Parse String VersionConstraint
parse = Parse :: forall k v.
(Text -> Parser (k, v))
-> (Object -> Parser v)
-> (Value -> Parser v)
-> (Text -> k)
-> Parse k v
Parse {
        parseString :: Text -> Parser (String, VersionConstraint)
parseString = Text -> Parser (String, VersionConstraint)
forall (m :: * -> *).
MonadFail m =>
Text -> m (String, VersionConstraint)
parseSystemBuildTool
      , parseListItem :: Object -> Parser VersionConstraint
parseListItem = (Object -> Key -> Parser VersionConstraint
forall a. FromValue a => Object -> Key -> Parser a
.: Key
"version")
      , parseDictItem :: Value -> Parser VersionConstraint
parseDictItem = Value -> Parser VersionConstraint
versionConstraint
      , parseName :: Text -> String
parseName = Text -> String
T.unpack
      }

      parseSystemBuildTool :: Fail.MonadFail m => Text -> m (String, VersionConstraint)
      parseSystemBuildTool :: Text -> m (String, VersionConstraint)
parseSystemBuildTool = (LegacyExeDependency -> (String, VersionConstraint))
-> m LegacyExeDependency -> m (String, VersionConstraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LegacyExeDependency -> (String, VersionConstraint)
fromCabal (m LegacyExeDependency -> m (String, VersionConstraint))
-> (Text -> m LegacyExeDependency)
-> Text
-> m (String, VersionConstraint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> m LegacyExeDependency
forall (m :: * -> *) a.
(MonadFail m, Parsec a) =>
String -> String -> m a
cabalParse String
"system build tool" (String -> m LegacyExeDependency)
-> (Text -> String) -> Text -> m LegacyExeDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
        where
          fromCabal :: D.LegacyExeDependency -> (String, VersionConstraint)
          fromCabal :: LegacyExeDependency -> (String, VersionConstraint)
fromCabal (D.LegacyExeDependency String
name VersionRange
version) = (String
name, VersionRange -> VersionConstraint
versionConstraintFromCabal VersionRange
version)