{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Hpack.Syntax.Dependency (
  Dependencies(..)
, DependencyVersion(..)
, SourceDependency(..)
, GitRef
, GitUrl
, githubBaseUrl
, scientificToVersion
) where

import qualified Data.Text as T
import           Data.Semigroup (Semigroup(..))
import           Text.PrettyPrint (renderStyle, Style(..), Mode(..))
import           Control.Monad
import qualified Distribution.Compat.ReadP as D
import qualified Distribution.Package as D
import qualified Distribution.Text as D
import qualified Distribution.Version as D
import           Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import           Data.Scientific
import           Control.Applicative
import           GHC.Exts

import           Data.Aeson.Config.FromValue

githubBaseUrl :: String
githubBaseUrl = "https://github.com/"

newtype Dependencies = Dependencies {
  unDependencies :: Map String DependencyVersion
} deriving (Eq, Show, Semigroup, Monoid)

instance IsList Dependencies where
  type Item Dependencies = (String, DependencyVersion)
  fromList = Dependencies . Map.fromList
  toList = Map.toList . unDependencies

data DependencyVersion =
    AnyVersion
  | VersionRange String
  | SourceDependency SourceDependency
  deriving (Eq, Show)

data SourceDependency = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath
  deriving (Eq, Show)

type GitUrl = String
type GitRef = String

instance FromValue Dependencies where
  fromValue v = case v of
    String _ -> dependenciesFromList . return <$> fromValue v
    Array _ -> dependenciesFromList <$> fromValue v
    Object _ -> Dependencies <$> fromValue v
    _ -> typeMismatch "Array, Object, or String" v
    where
      fromDependency :: Dependency -> (String, DependencyVersion)
      fromDependency (Dependency name version) = (name, version)

      dependenciesFromList :: [Dependency] -> Dependencies
      dependenciesFromList = Dependencies . Map.fromList . map fromDependency


instance FromValue DependencyVersion where
  fromValue v = case v of
    Null -> return AnyVersion
    Object _ -> SourceDependency <$> fromValue v
    Number n -> return (scientificToDependencyVersion n)
    String s -> parseVersionRange ("== " ++ input) <|> parseVersionRange input
      where
        input = T.unpack s

    _ -> typeMismatch "Null, Object, Number, or String" v

scientificToDependencyVersion :: Scientific -> DependencyVersion
scientificToDependencyVersion n = VersionRange ("==" ++ version)
  where
    version = scientificToVersion n

scientificToVersion :: Scientific -> String
scientificToVersion n = version
  where
    version = formatScientific Fixed (Just decimalPlaces) n
    decimalPlaces
      | e < 0 = abs e
      | otherwise = 0
    e = base10Exponent n

instance FromValue SourceDependency where
  fromValue = withObject (\o -> let
    local :: Parser SourceDependency
    local = Local <$> o .: "path"

    git :: Parser SourceDependency
    git = GitRef <$> url <*> ref <*> subdir

    url :: Parser String
    url =
          ((githubBaseUrl ++) <$> o .: "github")
      <|> (o .: "git")
      <|> fail "neither key \"git\" nor key \"github\" present"

    ref :: Parser String
    ref = o .: "ref"

    subdir :: Parser (Maybe FilePath)
    subdir = o .:? "subdir"

    in local <|> git)

data Dependency = Dependency {
  _dependencyName :: String
, _dependencyVersion :: DependencyVersion
} deriving (Eq, Show)

instance FromValue Dependency where
  fromValue v = case v of
    String s -> uncurry Dependency <$> parseDependency (T.unpack s)
    Object o -> addSourceDependency o
    _ -> typeMismatch "Object or String" v
    where
      addSourceDependency o = Dependency <$> name <*> (SourceDependency <$> fromValue v)
        where
          name :: Parser String
          name = o .: "name"

depPkgName :: D.Dependency -> String
#if MIN_VERSION_Cabal(2,0,0)
depPkgName = D.unPackageName . D.depPkgName
#else
depPkgName (D.Dependency (D.PackageName name) _) = name
#endif

depVerRange :: D.Dependency -> D.VersionRange
#if MIN_VERSION_Cabal(2,0,0)
depVerRange = D.depVerRange
#else
depVerRange (D.Dependency _ versionRange) = versionRange
#endif

parseDependency :: Monad m => String -> m (String, DependencyVersion)
parseDependency = liftM fromCabal . parseCabalDependency
  where
    fromCabal :: D.Dependency -> (String, DependencyVersion)
    fromCabal d = (depPkgName d, dependencyVersionFromCabal $ depVerRange d)

dependencyVersionFromCabal :: D.VersionRange -> DependencyVersion
dependencyVersionFromCabal versionRange
  | D.isAnyVersion versionRange = AnyVersion
  | otherwise = VersionRange . renderStyle style . D.disp $ versionRange
  where
    style = Style OneLineMode 0 0

parseCabalDependency :: Monad m => String -> m D.Dependency
parseCabalDependency = cabalParse "dependency"

parseVersionRange :: Monad m => String -> m DependencyVersion
parseVersionRange = liftM dependencyVersionFromCabal . parseCabalVersionRange

parseCabalVersionRange :: Monad m => String -> m D.VersionRange
parseCabalVersionRange = cabalParse "constraint"

cabalParse :: (Monad m, D.Text a) => String -> String -> m a
cabalParse subject s = case [d | (d, "") <- D.readP_to_S D.parse s] of
  [d] -> return d
  _ -> fail $ unwords ["invalid",  subject, show s]