module Language.PureScript.Publish.Registry.Compat where
import Protolude
import Data.Map qualified as Map
import Web.Bower.PackageMeta qualified as Bower
import Data.Bitraversable (Bitraversable(..))
import Data.Aeson.BetterErrors (key, asText, keyMay, eachInObject, Parse, throwCustomError)
toBowerPackage :: PursJson -> Either Bower.BowerError Bower.PackageMeta
toBowerPackage :: PursJson -> Either BowerError PackageMeta
toBowerPackage PursJson{Maybe Text
Map Text Text
Text
pursJsonDependencies :: PursJson -> Map Text Text
pursJsonDescription :: PursJson -> Maybe Text
pursJsonLocation :: PursJson -> Text
pursJsonLicense :: PursJson -> Text
pursJsonName :: PursJson -> Text
pursJsonDependencies :: Map Text Text
pursJsonDescription :: Maybe Text
pursJsonLocation :: Text
pursJsonLicense :: Text
pursJsonName :: Text
..} = do
PackageName
bowerName <- Text -> Either BowerError PackageName
Bower.parsePackageName (Text
"purescript-" forall a. Semigroup a => a -> a -> a
<> Text
pursJsonName)
let
bowerDescription :: Maybe Text
bowerDescription = Maybe Text
pursJsonDescription
bowerMain :: [a]
bowerMain = []
bowerModuleType :: [a]
bowerModuleType = []
bowerLicense :: [Text]
bowerLicense = [ Text
pursJsonLicense ]
bowerIgnore :: [a]
bowerIgnore = []
bowerKeywords :: [a]
bowerKeywords = []
bowerAuthors :: [a]
bowerAuthors = []
bowerHomepage :: Maybe Text
bowerHomepage = forall a. a -> Maybe a
Just Text
pursJsonLocation
bowerRepository :: Maybe Repository
bowerRepository = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bower.Repository { repositoryUrl :: Text
repositoryUrl = Text
pursJsonLocation, repositoryType :: Text
repositoryType = Text
"git" }
bowerDevDependencies :: [a]
bowerDevDependencies = []
bowerResolutions :: [a]
bowerResolutions = []
bowerPrivate :: Bool
bowerPrivate = Bool
False
let parseDependencies :: [(Text, Text)] -> Either BowerError [(PackageName, VersionRange)]
parseDependencies = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Text -> Either BowerError PackageName
Bower.parsePackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"purescript-" forall a. Semigroup a => a -> a -> a
<>)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VersionRange
Bower.VersionRange))
[(PackageName, VersionRange)]
bowerDependencies <- [(Text, Text)] -> Either BowerError [(PackageName, VersionRange)]
parseDependencies forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text Text
pursJsonDependencies
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bower.PackageMeta {Bool
[(PackageName, VersionRange)]
[Text]
Maybe Text
Maybe Repository
PackageName
forall a. [a]
bowerName :: PackageName
bowerDescription :: Maybe Text
bowerMain :: [FilePath]
bowerModuleType :: [ModuleType]
bowerLicense :: [Text]
bowerIgnore :: [Text]
bowerKeywords :: [Text]
bowerAuthors :: [Author]
bowerHomepage :: Maybe Text
bowerRepository :: Maybe Repository
bowerDependencies :: [(PackageName, VersionRange)]
bowerDevDependencies :: [(PackageName, VersionRange)]
bowerResolutions :: [(PackageName, Version)]
bowerPrivate :: Bool
bowerDependencies :: [(PackageName, VersionRange)]
bowerPrivate :: Bool
bowerResolutions :: forall a. [a]
bowerDevDependencies :: forall a. [a]
bowerRepository :: Maybe Repository
bowerHomepage :: Maybe Text
bowerAuthors :: forall a. [a]
bowerKeywords :: forall a. [a]
bowerIgnore :: forall a. [a]
bowerLicense :: [Text]
bowerModuleType :: forall a. [a]
bowerMain :: forall a. [a]
bowerDescription :: Maybe Text
bowerName :: PackageName
..}
data PursJson = PursJson
{
PursJson -> Text
pursJsonName :: Text
, PursJson -> Text
pursJsonLicense :: Text
, PursJson -> Text
pursJsonLocation :: Text
, PursJson -> Maybe Text
pursJsonDescription :: Maybe Text
, PursJson -> Map Text Text
pursJsonDependencies :: Map Text Text
}
data PursJsonError
= MalformedLocationField
deriving (PursJsonError -> PursJsonError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PursJsonError -> PursJsonError -> Bool
$c/= :: PursJsonError -> PursJsonError -> Bool
== :: PursJsonError -> PursJsonError -> Bool
$c== :: PursJsonError -> PursJsonError -> Bool
Eq, Int -> PursJsonError -> ShowS
[PursJsonError] -> ShowS
PursJsonError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PursJsonError] -> ShowS
$cshowList :: [PursJsonError] -> ShowS
show :: PursJsonError -> FilePath
$cshow :: PursJsonError -> FilePath
showsPrec :: Int -> PursJsonError -> ShowS
$cshowsPrec :: Int -> PursJsonError -> ShowS
Show, Eq PursJsonError
PursJsonError -> PursJsonError -> Bool
PursJsonError -> PursJsonError -> Ordering
PursJsonError -> PursJsonError -> PursJsonError
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 :: PursJsonError -> PursJsonError -> PursJsonError
$cmin :: PursJsonError -> PursJsonError -> PursJsonError
max :: PursJsonError -> PursJsonError -> PursJsonError
$cmax :: PursJsonError -> PursJsonError -> PursJsonError
>= :: PursJsonError -> PursJsonError -> Bool
$c>= :: PursJsonError -> PursJsonError -> Bool
> :: PursJsonError -> PursJsonError -> Bool
$c> :: PursJsonError -> PursJsonError -> Bool
<= :: PursJsonError -> PursJsonError -> Bool
$c<= :: PursJsonError -> PursJsonError -> Bool
< :: PursJsonError -> PursJsonError -> Bool
$c< :: PursJsonError -> PursJsonError -> Bool
compare :: PursJsonError -> PursJsonError -> Ordering
$ccompare :: PursJsonError -> PursJsonError -> Ordering
Ord, forall x. Rep PursJsonError x -> PursJsonError
forall x. PursJsonError -> Rep PursJsonError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PursJsonError x -> PursJsonError
$cfrom :: forall x. PursJsonError -> Rep PursJsonError x
Generic)
instance NFData PursJsonError
showPursJsonError :: PursJsonError -> Text
showPursJsonError :: PursJsonError -> Text
showPursJsonError = \case
PursJsonError
MalformedLocationField ->
Text
"The 'location' field must be either '{ \"githubOwner\": OWNER, \"githubRepo\": REPO }' or '{ \"gitUrl\": URL }'."
asPursJson :: Parse PursJsonError PursJson
asPursJson :: Parse PursJsonError PursJson
asPursJson = do
Text
pursJsonName <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"name" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
Maybe Text
pursJsonDescription <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
"description" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
Text
pursJsonLicense <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"license" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
Map Text Text
pursJsonDependencies <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"dependencies" (forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [(Text, a)]
eachInObject forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
Text
pursJsonLocation <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"location" ParseT PursJsonError Identity Text
asOwnerRepoOrGitUrl
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PursJson{Maybe Text
Map Text Text
Text
pursJsonLocation :: Text
pursJsonDependencies :: Map Text Text
pursJsonLicense :: Text
pursJsonDescription :: Maybe Text
pursJsonName :: Text
pursJsonDependencies :: Map Text Text
pursJsonDescription :: Maybe Text
pursJsonLocation :: Text
pursJsonLicense :: Text
pursJsonName :: Text
..}
where
asOwnerRepoOrGitUrl :: ParseT PursJsonError Identity Text
asOwnerRepoOrGitUrl =
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError forall {err}. ParseT err Identity Text
asOwnerRepo (\ParseError PursJsonError
_ -> forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError forall {err}. ParseT err Identity Text
asGitUrl (\ParseError PursJsonError
_ -> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
throwCustomError PursJsonError
MalformedLocationField))
asGitUrl :: ParseT err Identity Text
asGitUrl =
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"gitUrl" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
asOwnerRepo :: ParseT err Identity Text
asOwnerRepo = do
Text
githubOwner <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"githubOwner" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
Text
githubRepo <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"githubRepo" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
"https://github.com/" forall a. Semigroup a => a -> a -> a
<> Text
githubOwner forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
githubRepo forall a. Semigroup a => a -> a -> a
<> Text
".git"