{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE TemplateHaskell #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE BangPatterns #-}

{-# LANGUAGE DeriveGeneric #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-# LANGUAGE DeriveDataTypeable #-}

-- | Versions for packages.

module Stack.Types.Version

(Version

,Cabal.VersionRange -- TODO in the future should have a newtype wrapper

,MajorVersion (..)

,getMajorVersion

,fromMajorVersion

,parseMajorVersionFromString

,versionParser

,parseVersion

,parseVersionFromString

,versionString

,versionText

,toCabalVersion

,fromCabalVersion

,mkVersion

,versionRangeText

,withinRange)

where

import Control.Applicative

import Control.DeepSeq

import Control.Monad.Catch

import Data.Aeson

import Data.Attoparsec.ByteString.Char8

import Data.Binary (Binary)

import Data.ByteString (ByteString)

import qualified Data.ByteString.Char8 as S8

import Data.Data

import Data.Hashable

import Data.List

import Data.Map (Map)

import qualified Data.Map as Map

import Data.Text (Text)

import qualified Data.Text as T

import Data.Vector.Binary ()

import Data.Vector.Unboxed (Vector)

import qualified Data.Vector.Unboxed as V

import Data.Word

import Distribution.Text (disp)

import qualified Distribution.Version as Cabal

import GHC.Generics

import Language.Haskell.TH

import Language.Haskell.TH.Syntax

import Prelude -- Fix warning: Word in Prelude from base-4.8.

import Text.PrettyPrint (render)

-- | A parse fail.

data VersionParseFail =

VersionParseFail ByteString

| NotAMajorVersion Version

deriving (Show,Typeable)

instance Exception VersionParseFail

-- | A package version.

newtype Version =

Version {unVersion :: Vector Word}

deriving (Eq,Ord,Typeable,Data,Generic,Binary,NFData)

-- | The first two components of a version.

data MajorVersion = MajorVersion !Word !Word

deriving (Typeable, Eq, Ord)

instance Show MajorVersion where

show (MajorVersion x y) = concat [show x, ".", show y]

instance ToJSON MajorVersion where

toJSON = toJSON . fromMajorVersion

-- | Parse major version from @String@

parseMajorVersionFromString :: MonadThrow m => String -> m MajorVersion

parseMajorVersionFromString s = do

Version v <- parseVersionFromString s

if V.length v == 2

then return $ getMajorVersion (Version v)

else throwM $ NotAMajorVersion (Version v)

instance FromJSON MajorVersion where

parseJSON = withText "MajorVersion"

$ either (fail . show) return

. parseMajorVersionFromString

. T.unpack

instance FromJSON a => FromJSON (Map MajorVersion a) where

parseJSON val = do

m <- parseJSON val

fmap Map.fromList $ mapM go $ Map.toList m

where

go (k, v) = do

k' <- either (fail . show) return $ parseMajorVersionFromString k

return (k', v)

-- | Returns the first two components, defaulting to 0 if not present

getMajorVersion :: Version -> MajorVersion

getMajorVersion (Version v) =

case V.length v of

0 -> MajorVersion 0 0

1 -> MajorVersion (V.head v) 0

_ -> MajorVersion (V.head v) (v V.! 1)

-- | Convert a two-component version into a @Version@

fromMajorVersion :: MajorVersion -> Version

fromMajorVersion (MajorVersion x y) = Version $ V.fromList [x, y]

instance Hashable Version where

hashWithSalt i = hashWithSalt i . V.toList . unVersion

instance Lift Version where

lift (Version n) =

appE (conE 'Version)

(appE (varE 'V.fromList)

(listE (map (litE . IntegerL . fromIntegral)

(V.toList n))))

instance Show Version where

show (Version v) =

intercalate "."

(map show (V.toList v))

instance ToJSON Version where

toJSON = toJSON . versionText

instance FromJSON Version where

parseJSON j =

do s <- parseJSON j

case parseVersionFromString s of

Nothing ->

fail ("Couldn't parse package version: " ++ s)

Just ver -> return ver

-- | Attoparsec parser for a package version from bytestring.

versionParser :: Parser Version

versionParser =

do ls <- ((:) <$> num <*> many num')

let !v = V.fromList ls

return (Version v)

where num = decimal

num' = point *> num

point = satisfy (== '.')

-- | Convenient way to parse a package version from a bytestring.

parseVersion :: MonadThrow m => ByteString -> m Version

parseVersion x = go x

where go =

either (const (throwM (VersionParseFail x))) return .

parseOnly (versionParser <* endOfInput)

-- | Migration function.

parseVersionFromString :: MonadThrow m => String -> m Version

parseVersionFromString =

parseVersion . S8.pack

-- | Get a string representation of a package version.

versionString :: Version -> String

versionString (Version v) =

intercalate "."

(map show (V.toList v))

-- | Get a string representation of a package version.

versionText :: Version -> Text

versionText (Version v) =

T.intercalate

"."

(map (T.pack . show)

(V.toList v))

-- | Convert to a Cabal version.

toCabalVersion :: Version -> Cabal.Version

toCabalVersion (Version v) =

Cabal.Version (map fromIntegral (V.toList v)) []

-- | Convert from a Cabal version.

fromCabalVersion :: Cabal.Version -> Version

fromCabalVersion (Cabal.Version vs _) =

let !v = V.fromList (map fromIntegral vs)

in Version v

-- | Make a package version.

mkVersion :: String -> Q Exp

mkVersion s =

case parseVersionFromString s of

Nothing -> error ("Invalid package version: " ++ show s)

Just pn -> [|pn|]

-- | Display a version range

versionRangeText :: Cabal.VersionRange -> Text

versionRangeText = T.pack . render . disp

-- | Check if a version is within a version range.

withinRange :: Version -> Cabal.VersionRange -> Bool

withinRange v r = toCabalVersion v `Cabal.withinRange` r