{-# LANGUAGE NoImplicitPrelude          #-}

-- | A ghc-pkg id.


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

import           Data.Attoparsec.Text
                   ( Parser, choice, digit, endOfInput, letter, many1, parseOnly
                   , satisfy
                   )
import qualified Data.Text as T
import           Database.Persist.Sql ( PersistField, PersistFieldSql )
import           Pantry.Internal.AesonExtended
                   ( FromJSON (..), ToJSON (..), withText )
import           Prelude ( Read (..) )
import           Stack.Prelude

-- | A parse fail.

newtype GhcPkgIdParseFail
  = GhcPkgIdParseFail Text
  deriving (Int -> GhcPkgIdParseFail -> ShowS
[GhcPkgIdParseFail] -> ShowS
GhcPkgIdParseFail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhcPkgIdParseFail] -> ShowS
$cshowList :: [GhcPkgIdParseFail] -> ShowS
show :: GhcPkgIdParseFail -> String
$cshow :: GhcPkgIdParseFail -> String
showsPrec :: Int -> GhcPkgIdParseFail -> ShowS
$cshowsPrec :: Int -> GhcPkgIdParseFail -> ShowS
Show, Typeable)

instance Exception GhcPkgIdParseFail where
  displayException :: GhcPkgIdParseFail -> String
displayException (GhcPkgIdParseFail Text
bs) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Error: [S-5359]\n"
    , String
"Invalid package ID: "
    , forall a. Show a => a -> String
show Text
bs
    ]

-- | A ghc-pkg package identifier.

newtype GhcPkgId
  = GhcPkgId Text
  deriving (Typeable GhcPkgId
GhcPkgId -> DataType
GhcPkgId -> Constr
(forall b. Data b => b -> b) -> GhcPkgId -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> GhcPkgId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GhcPkgId -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GhcPkgId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GhcPkgId -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, GhcPkgId -> GhcPkgId -> Bool
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, 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, Eq 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
Ord, PersistValue -> Either Text GhcPkgId
GhcPkgId -> PersistValue
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
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy GhcPkgId -> SqlType
$csqlType :: Proxy GhcPkgId -> SqlType
PersistFieldSql, Typeable)

instance Hashable GhcPkgId

instance NFData GhcPkgId

instance Show GhcPkgId where
  show :: GhcPkgId -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcPkgId -> String
ghcPkgIdString

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

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

instance ToJSON GhcPkgId where
  toJSON :: GhcPkgId -> Value
toJSON GhcPkgId
g =
    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 :: forall (m :: * -> *). MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId Text
x = Text -> m GhcPkgId
go Text
x
 where
  go :: Text -> m GhcPkgId
go = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
         (forall a b. a -> b -> a
const (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> GhcPkgIdParseFail
GhcPkgIdParseFail Text
x)))
         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
parseOnly (Parser Text GhcPkgId
ghcPkgIdParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput)

-- | A parser for a package-version-hash pair.

ghcPkgIdParser :: Parser GhcPkgId
ghcPkgIdParser :: Parser Text GhcPkgId
ghcPkgIdParser =
  let elements :: String
elements = String
"_.-" :: String
  in  Text -> GhcPkgId
GhcPkgId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text Char
digit, Parser Text Char
letter, (Char -> Bool) -> Parser Text Char
satisfy (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