BuildTools.hs

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

import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Semigroup (Semigroup(..))
import           Data.Bifunctor
import           Control.Applicative
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 (Show, Eq)

newtype BuildTools = BuildTools {
  unBuildTools :: [(ParseBuildTool, DependencyVersion)]
} deriving (Show, Eq, Semigroup, Monoid)

instance FromValue BuildTools where
  fromValue = fmap BuildTools . parseDependencies parse
    where
      parse :: Parse ParseBuildTool DependencyVersion
      parse = Parse {
        parseString = buildToolFromString
      , parseListItem = objectDependency
      , parseDictItem = dependencyVersion
      , parseName = nameToBuildTool
      }

      nameToBuildTool :: Text -> ParseBuildTool
      nameToBuildTool (T.unpack -> name) = case break (== ':') name of
        (executable, "") -> UnqualifiedBuildTool executable
        (package, executable) -> QualifiedBuildTool package (drop 1 executable)

      buildToolFromString :: Text -> Parser (ParseBuildTool, DependencyVersion)
      buildToolFromString s = parseQualifiedBuildTool s <|> parseUnqualifiedBuildTool s

      parseQualifiedBuildTool :: Monad m => Text -> m (ParseBuildTool, DependencyVersion)
      parseQualifiedBuildTool = fmap fromCabal . cabalParse "build tool" . T.unpack
        where
          fromCabal :: D.ExeDependency -> (ParseBuildTool, DependencyVersion)
          fromCabal (D.ExeDependency package executable version) = (
              QualifiedBuildTool (D.unPackageName package) (D.unUnqualComponentName executable)
            , DependencyVersion Nothing $ versionConstraintFromCabal version
            )

      parseUnqualifiedBuildTool :: Monad m => Text -> m (ParseBuildTool, DependencyVersion)
      parseUnqualifiedBuildTool = fmap (first UnqualifiedBuildTool) . parseDependency "build tool"

newtype SystemBuildTools = SystemBuildTools {
  unSystemBuildTools :: Map String VersionConstraint
} deriving (Show, Eq, Semigroup, Monoid)

instance FromValue SystemBuildTools where
  fromValue = fmap (SystemBuildTools . Map.fromList) . parseDependencies parse
    where
      parse :: Parse String VersionConstraint
      parse = Parse {
        parseString = parseSystemBuildTool
      , parseListItem = (.: "version")
      , parseDictItem = versionConstraint
      , parseName = T.unpack
      }

      parseSystemBuildTool :: Monad m => Text -> m (String, VersionConstraint)
      parseSystemBuildTool = fmap fromCabal . cabalParse "system build tool" . T.unpack
        where
          fromCabal :: D.LegacyExeDependency -> (String, VersionConstraint)
          fromCabal (D.LegacyExeDependency name version) = (name, versionConstraintFromCabal version)