{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | A ghc-pkg id.

module Stack.Types.GhcPkgId
  (GhcPkgId
  ,unGhcPkgId
  ,ghcPkgIdParser
  ,parseGhcPkgId
  ,ghcPkgIdString)
  where

import           Stack.Prelude
import           Pantry.Internal.AesonExtended
import           Data.Attoparsec.Text
import qualified Data.Text as T
import           Database.Persist.Sql (PersistField, PersistFieldSql)
import           Prelude (Read (..))

-- | A parse fail.
newtype GhcPkgIdParseFail
  = GhcPkgIdParseFail Text
  deriving Typeable
instance Show GhcPkgIdParseFail where
    show :: GhcPkgIdParseFail -> String
show (GhcPkgIdParseFail Text
bs) = String
"Invalid package ID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
bs
instance Exception GhcPkgIdParseFail

-- | A ghc-pkg package identifier.
newtype GhcPkgId = GhcPkgId Text
  deriving (GhcPkgId -> GhcPkgId -> Bool
(GhcPkgId -> GhcPkgId -> Bool)
-> (GhcPkgId -> GhcPkgId -> Bool) -> Eq GhcPkgId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcPkgId -> GhcPkgId -> Bool
$c/= :: GhcPkgId -> GhcPkgId -> Bool
== :: GhcPkgId -> GhcPkgId -> Bool
$c== :: GhcPkgId -> GhcPkgId -> Bool
Eq,Eq GhcPkgId
Eq GhcPkgId
-> (GhcPkgId -> GhcPkgId -> Ordering)
-> (GhcPkgId -> GhcPkgId -> Bool)
-> (GhcPkgId -> GhcPkgId -> Bool)
-> (GhcPkgId -> GhcPkgId -> Bool)
-> (GhcPkgId -> GhcPkgId -> Bool)
-> (GhcPkgId -> GhcPkgId -> GhcPkgId)
-> (GhcPkgId -> GhcPkgId -> GhcPkgId)
-> Ord GhcPkgId
GhcPkgId -> GhcPkgId -> Bool
GhcPkgId -> GhcPkgId -> Ordering
GhcPkgId -> GhcPkgId -> GhcPkgId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GhcPkgId -> GhcPkgId -> GhcPkgId
$cmin :: GhcPkgId -> GhcPkgId -> GhcPkgId
max :: GhcPkgId -> GhcPkgId -> GhcPkgId
$cmax :: GhcPkgId -> GhcPkgId -> GhcPkgId
>= :: GhcPkgId -> GhcPkgId -> Bool
$c>= :: GhcPkgId -> GhcPkgId -> Bool
> :: GhcPkgId -> GhcPkgId -> Bool
$c> :: GhcPkgId -> GhcPkgId -> Bool
<= :: GhcPkgId -> GhcPkgId -> Bool
$c<= :: GhcPkgId -> GhcPkgId -> Bool
< :: GhcPkgId -> GhcPkgId -> Bool
$c< :: GhcPkgId -> GhcPkgId -> Bool
compare :: GhcPkgId -> GhcPkgId -> Ordering
$ccompare :: GhcPkgId -> GhcPkgId -> Ordering
$cp1Ord :: Eq GhcPkgId
Ord,Typeable GhcPkgId
DataType
Constr
Typeable GhcPkgId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> GhcPkgId -> c GhcPkgId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GhcPkgId)
-> (GhcPkgId -> Constr)
-> (GhcPkgId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GhcPkgId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhcPkgId))
-> ((forall b. Data b => b -> b) -> GhcPkgId -> GhcPkgId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r)
-> (forall u. (forall d. Data d => d -> u) -> GhcPkgId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> GhcPkgId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId)
-> Data GhcPkgId
GhcPkgId -> DataType
GhcPkgId -> Constr
(forall b. Data b => b -> b) -> GhcPkgId -> GhcPkgId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhcPkgId -> c GhcPkgId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhcPkgId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GhcPkgId -> u
forall u. (forall d. Data d => d -> u) -> GhcPkgId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhcPkgId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhcPkgId -> c GhcPkgId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GhcPkgId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhcPkgId)
$cGhcPkgId :: Constr
$tGhcPkgId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
gmapMp :: (forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
gmapM :: (forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GhcPkgId -> m GhcPkgId
gmapQi :: Int -> (forall d. Data d => d -> u) -> GhcPkgId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GhcPkgId -> u
gmapQ :: (forall d. Data d => d -> u) -> GhcPkgId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GhcPkgId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GhcPkgId -> r
gmapT :: (forall b. Data b => b -> b) -> GhcPkgId -> GhcPkgId
$cgmapT :: (forall b. Data b => b -> b) -> GhcPkgId -> GhcPkgId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhcPkgId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhcPkgId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GhcPkgId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GhcPkgId)
dataTypeOf :: GhcPkgId -> DataType
$cdataTypeOf :: GhcPkgId -> DataType
toConstr :: GhcPkgId -> Constr
$ctoConstr :: GhcPkgId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhcPkgId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhcPkgId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhcPkgId -> c GhcPkgId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhcPkgId -> c GhcPkgId
$cp1Data :: Typeable GhcPkgId
Data,Typeable,(forall x. GhcPkgId -> Rep GhcPkgId x)
-> (forall x. Rep GhcPkgId x -> GhcPkgId) -> Generic GhcPkgId
forall x. Rep GhcPkgId x -> GhcPkgId
forall x. GhcPkgId -> Rep GhcPkgId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GhcPkgId x -> GhcPkgId
$cfrom :: forall x. GhcPkgId -> Rep GhcPkgId x
Generic,PersistValue -> Either Text GhcPkgId
GhcPkgId -> PersistValue
(GhcPkgId -> PersistValue)
-> (PersistValue -> Either Text GhcPkgId) -> PersistField GhcPkgId
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text GhcPkgId
$cfromPersistValue :: PersistValue -> Either Text GhcPkgId
toPersistValue :: GhcPkgId -> PersistValue
$ctoPersistValue :: GhcPkgId -> PersistValue
PersistField,PersistField GhcPkgId
Proxy GhcPkgId -> SqlType
PersistField GhcPkgId
-> (Proxy GhcPkgId -> SqlType) -> PersistFieldSql GhcPkgId
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy GhcPkgId -> SqlType
$csqlType :: Proxy GhcPkgId -> SqlType
$cp1PersistFieldSql :: PersistField GhcPkgId
PersistFieldSql)

instance Hashable GhcPkgId
instance NFData GhcPkgId

instance Show GhcPkgId where
  show :: GhcPkgId -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (GhcPkgId -> String) -> GhcPkgId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcPkgId -> String
ghcPkgIdString
instance Read GhcPkgId where
  readsPrec :: Int -> ReadS GhcPkgId
readsPrec Int
i = ((String, String) -> (GhcPkgId, String))
-> [(String, String)] -> [(GhcPkgId, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> GhcPkgId) -> (String, String) -> (GhcPkgId, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> GhcPkgId
GhcPkgId (Text -> GhcPkgId) -> (String -> Text) -> String -> GhcPkgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)) ([(String, String)] -> [(GhcPkgId, String)])
-> (String -> [(String, String)]) -> ReadS GhcPkgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(String, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i

instance FromJSON GhcPkgId where
  parseJSON :: Value -> Parser GhcPkgId
parseJSON = String -> (Text -> Parser GhcPkgId) -> Value -> Parser GhcPkgId
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"GhcPkgId" ((Text -> Parser GhcPkgId) -> Value -> Parser GhcPkgId)
-> (Text -> Parser GhcPkgId) -> Value -> Parser GhcPkgId
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text -> Either SomeException GhcPkgId
forall (m :: * -> *). MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId Text
t of
      Left SomeException
e -> String -> Parser GhcPkgId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GhcPkgId) -> String -> Parser GhcPkgId
forall a b. (a -> b) -> a -> b
$ (SomeException, Text) -> String
forall a. Show a => a -> String
show (SomeException
e, Text
t)
      Right GhcPkgId
x -> GhcPkgId -> Parser GhcPkgId
forall (m :: * -> *) a. Monad m => a -> m a
return GhcPkgId
x

instance ToJSON GhcPkgId where
  toJSON :: GhcPkgId -> Value
toJSON GhcPkgId
g =
    String -> Value
forall a. ToJSON a => a -> Value
toJSON (GhcPkgId -> String
ghcPkgIdString GhcPkgId
g)

-- | Convenient way to parse a package name from a 'Text'.
parseGhcPkgId :: MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId :: Text -> m GhcPkgId
parseGhcPkgId Text
x = Text -> m GhcPkgId
go Text
x
  where go :: Text -> m GhcPkgId
go =
          (String -> m GhcPkgId)
-> (GhcPkgId -> m GhcPkgId) -> Either String GhcPkgId -> m GhcPkgId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m GhcPkgId -> String -> m GhcPkgId
forall a b. a -> b -> a
const (GhcPkgIdParseFail -> m GhcPkgId
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> GhcPkgIdParseFail
GhcPkgIdParseFail Text
x))) GhcPkgId -> m GhcPkgId
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GhcPkgId -> m GhcPkgId)
-> (Text -> Either String GhcPkgId) -> Text -> m GhcPkgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Parser GhcPkgId -> Text -> Either String GhcPkgId
forall a. Parser a -> Text -> Either String a
parseOnly (Parser GhcPkgId
ghcPkgIdParser Parser GhcPkgId -> Parser Text () -> Parser GhcPkgId
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)

-- | A parser for a package-version-hash pair.
ghcPkgIdParser :: Parser GhcPkgId
ghcPkgIdParser :: Parser GhcPkgId
ghcPkgIdParser =
    let elements :: String
elements =  String
"_.-" :: String in
    Text -> GhcPkgId
GhcPkgId (Text -> GhcPkgId) -> (String -> Text) -> String -> GhcPkgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> GhcPkgId) -> Parser Text String -> Parser GhcPkgId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 ([Parser Text Char] -> Parser Text Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text Char
digit, Parser Text Char
letter, (Char -> Bool) -> Parser Text Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
elements)])

-- | Get a string representation of GHC package id.
ghcPkgIdString :: GhcPkgId -> String
ghcPkgIdString :: GhcPkgId -> String
ghcPkgIdString (GhcPkgId Text
x) = Text -> String
T.unpack Text
x

-- | Get a text value of GHC package id
unGhcPkgId :: GhcPkgId -> Text
unGhcPkgId :: GhcPkgId -> Text
unGhcPkgId (GhcPkgId Text
v) = Text
v