module Stack.Types.PackageIdentifier
( PackageIdentifier(..)
, toTuple
, fromTuple
, parsePackageIdentifier
, parsePackageIdentifierFromString
, packageIdentifierParser
, packageIdentifierString
, packageIdentifierText
, toCabalPackageIdentifier )
where
import Control.Applicative
import Control.DeepSeq
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow, throwM)
import Data.Aeson.Extended
import Data.Attoparsec.Text
import Data.Data
import Data.Hashable
import Data.Store (Store)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Distribution.Package as C
import GHC.Generics
import Prelude hiding (FilePath)
import Stack.Types.PackageName
import Stack.Types.Version
newtype PackageIdentifierParseFail
= PackageIdentifierParseFail Text
deriving (Typeable)
instance Show PackageIdentifierParseFail where
show (PackageIdentifierParseFail bs) = "Invalid package identifier: " ++ show bs
instance Exception PackageIdentifierParseFail
data PackageIdentifier = PackageIdentifier
{
packageIdentifierName :: !PackageName
, packageIdentifierVersion :: !Version
} deriving (Eq,Ord,Generic,Data,Typeable)
instance NFData PackageIdentifier where
rnf (PackageIdentifier !p !v) =
seq (rnf p) (rnf v)
instance Hashable PackageIdentifier
instance Store PackageIdentifier
instance Show PackageIdentifier where
show = show . packageIdentifierString
instance ToJSON PackageIdentifier where
toJSON = toJSON . packageIdentifierString
instance FromJSON PackageIdentifier where
parseJSON = withText "PackageIdentifier" $ \t ->
case parsePackageIdentifier t of
Left e -> fail $ show (e, t)
Right x -> return x
toTuple :: PackageIdentifier -> (PackageName,Version)
toTuple (PackageIdentifier n v) = (n,v)
fromTuple :: (PackageName,Version) -> PackageIdentifier
fromTuple (n,v) = PackageIdentifier n v
packageIdentifierParser :: Parser PackageIdentifier
packageIdentifierParser =
do name <- packageNameParser
char '-'
version <- versionParser
return (PackageIdentifier name version)
parsePackageIdentifier :: MonadThrow m => Text -> m PackageIdentifier
parsePackageIdentifier x = go x
where go =
either (const (throwM (PackageIdentifierParseFail x))) return .
parseOnly (packageIdentifierParser <* endOfInput)
parsePackageIdentifierFromString :: MonadThrow m => String -> m PackageIdentifier
parsePackageIdentifierFromString =
parsePackageIdentifier . T.pack
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString (PackageIdentifier n v) = show n ++ "-" ++ show v
packageIdentifierText :: PackageIdentifier -> Text
packageIdentifierText = T.pack . packageIdentifierString
toCabalPackageIdentifier :: PackageIdentifier -> C.PackageIdentifier
toCabalPackageIdentifier x =
C.PackageIdentifier
(toCabalPackageName (packageIdentifierName x))
(toCabalVersion (packageIdentifierVersion x))