module Stack.Types.PackageIdentifier
( PackageIdentifier(..)
, toTuple
, fromTuple
, parsePackageIdentifier
, parsePackageIdentifierFromString
, packageIdentifierParser
, packageIdentifierString
, packageIdentifierText )
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.Binary.VersionTagged (Binary, HasStructuralInfo)
import Data.Data
import Data.Hashable
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics
import Prelude hiding (FilePath)
import Stack.Types.PackageName
import Stack.Types.Version
data 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 Binary PackageIdentifier
instance HasStructuralInfo 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