{-# LANGUAGE NoImplicitPrelude          #-}

-- | A ghc-pkg id.


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

import           Data.Aeson.Types ( FromJSON (..), ToJSON (..), withText )
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           Prelude ( Read (..) )
import           Stack.Prelude

-- | A parse fail.

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

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

-- | A ghc-pkg package identifier.

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

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 a b c. (a -> b) -> (a, c) -> (b, c)
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 a. String -> Parser a
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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: forall (m :: * -> *). MonadThrow m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> GhcPkgIdParseFail
GhcPkgIdParseFail Text
x)))
         GhcPkgId -> m GhcPkgId
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 a b. Parser Text a -> Parser Text b -> Parser Text a
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 a. Eq a => a -> [a] -> 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