{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
module Web.Bower.PackageMeta.Internal where
import Control.Monad
import Control.Category ((>>>))
import Control.Monad.Error.Class (MonadError(..))
import Control.DeepSeq
import GHC.Generics
import Data.Char
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as B
import Data.Aeson ((.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as A.Key
import qualified Data.Aeson.Types as Aeson
import Data.Aeson.BetterErrors (Parse, ParseError, asText, asString, asBool, eachInArray, eachInObjectWithKey, withText, key, keyMay, keyOrDefault, toAesonParser', toAesonParser, displayError, parse)
data PackageMeta = PackageMeta
{ PackageMeta -> PackageName
bowerName :: PackageName
, PackageMeta -> Maybe Text
bowerDescription :: Maybe Text
, PackageMeta -> [[Char]]
bowerMain :: [FilePath]
, PackageMeta -> [ModuleType]
bowerModuleType :: [ModuleType]
, PackageMeta -> [Text]
bowerLicense :: [Text]
, PackageMeta -> [Text]
bowerIgnore :: [Text]
, PackageMeta -> [Text]
bowerKeywords :: [Text]
, PackageMeta -> [Author]
bowerAuthors :: [Author]
, PackageMeta -> Maybe Text
bowerHomepage :: Maybe Text
, PackageMeta -> Maybe Repository
bowerRepository :: Maybe Repository
, PackageMeta -> [(PackageName, VersionRange)]
bowerDependencies :: [(PackageName, VersionRange)]
, PackageMeta -> [(PackageName, VersionRange)]
bowerDevDependencies :: [(PackageName, VersionRange)]
, PackageMeta -> [(PackageName, Version)]
bowerResolutions :: [(PackageName, Version)]
, PackageMeta -> Bool
bowerPrivate :: Bool
}
deriving (Int -> PackageMeta -> ShowS
[PackageMeta] -> ShowS
PackageMeta -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageMeta] -> ShowS
$cshowList :: [PackageMeta] -> ShowS
show :: PackageMeta -> [Char]
$cshow :: PackageMeta -> [Char]
showsPrec :: Int -> PackageMeta -> ShowS
$cshowsPrec :: Int -> PackageMeta -> ShowS
Show, PackageMeta -> PackageMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageMeta -> PackageMeta -> Bool
$c/= :: PackageMeta -> PackageMeta -> Bool
== :: PackageMeta -> PackageMeta -> Bool
$c== :: PackageMeta -> PackageMeta -> Bool
Eq, Eq PackageMeta
PackageMeta -> PackageMeta -> Bool
PackageMeta -> PackageMeta -> Ordering
PackageMeta -> PackageMeta -> PackageMeta
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 :: PackageMeta -> PackageMeta -> PackageMeta
$cmin :: PackageMeta -> PackageMeta -> PackageMeta
max :: PackageMeta -> PackageMeta -> PackageMeta
$cmax :: PackageMeta -> PackageMeta -> PackageMeta
>= :: PackageMeta -> PackageMeta -> Bool
$c>= :: PackageMeta -> PackageMeta -> Bool
> :: PackageMeta -> PackageMeta -> Bool
$c> :: PackageMeta -> PackageMeta -> Bool
<= :: PackageMeta -> PackageMeta -> Bool
$c<= :: PackageMeta -> PackageMeta -> Bool
< :: PackageMeta -> PackageMeta -> Bool
$c< :: PackageMeta -> PackageMeta -> Bool
compare :: PackageMeta -> PackageMeta -> Ordering
$ccompare :: PackageMeta -> PackageMeta -> Ordering
Ord, forall x. Rep PackageMeta x -> PackageMeta
forall x. PackageMeta -> Rep PackageMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageMeta x -> PackageMeta
$cfrom :: forall x. PackageMeta -> Rep PackageMeta x
Generic)
instance NFData PackageMeta
newtype PackageName
= PackageName Text
deriving (Int -> PackageName -> ShowS
[PackageName] -> ShowS
PackageName -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageName] -> ShowS
$cshowList :: [PackageName] -> ShowS
show :: PackageName -> [Char]
$cshow :: PackageName -> [Char]
showsPrec :: Int -> PackageName -> ShowS
$cshowsPrec :: Int -> PackageName -> ShowS
Show, PackageName -> PackageName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageName -> PackageName -> Bool
$c/= :: PackageName -> PackageName -> Bool
== :: PackageName -> PackageName -> Bool
$c== :: PackageName -> PackageName -> Bool
Eq, Eq PackageName
PackageName -> PackageName -> Bool
PackageName -> PackageName -> Ordering
PackageName -> PackageName -> PackageName
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 :: PackageName -> PackageName -> PackageName
$cmin :: PackageName -> PackageName -> PackageName
max :: PackageName -> PackageName -> PackageName
$cmax :: PackageName -> PackageName -> PackageName
>= :: PackageName -> PackageName -> Bool
$c>= :: PackageName -> PackageName -> Bool
> :: PackageName -> PackageName -> Bool
$c> :: PackageName -> PackageName -> Bool
<= :: PackageName -> PackageName -> Bool
$c<= :: PackageName -> PackageName -> Bool
< :: PackageName -> PackageName -> Bool
$c< :: PackageName -> PackageName -> Bool
compare :: PackageName -> PackageName -> Ordering
$ccompare :: PackageName -> PackageName -> Ordering
Ord, forall x. Rep PackageName x -> PackageName
forall x. PackageName -> Rep PackageName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageName x -> PackageName
$cfrom :: forall x. PackageName -> Rep PackageName x
Generic)
instance NFData PackageName
runPackageName :: PackageName -> Text
runPackageName :: PackageName -> Text
runPackageName (PackageName Text
s) = Text
s
mkPackageName :: Text -> Either PackageNameError PackageName
mkPackageName :: Text -> Either PackageNameError PackageName
mkPackageName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> PackageName
PackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *} {b} {a}.
Foldable t =>
t (b -> Bool, b -> a) -> b -> Either a b
validateAll [(Text -> Bool, Text -> PackageNameError)]
validators
where
dashOrDot :: [Char]
dashOrDot = [Char
'-', Char
'.']
validateAll :: t (b -> Bool, b -> a) -> b -> Either a b
validateAll t (b -> Bool, b -> a)
vs b
x = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {t} {a}. t -> (t -> Bool, t -> a) -> Either a t
validateWith b
x) t (b -> Bool, b -> a)
vs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return b
x
validateWith :: t -> (t -> Bool, t -> a) -> Either a t
validateWith t
x (t -> Bool
p, t -> a
err)
| t -> Bool
p t
x = forall a b. b -> Either a b
Right t
x
| Bool
otherwise = forall a b. a -> Either a b
Left (t -> a
err t
x)
validChar :: Char -> Bool
validChar Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
dashOrDot)
validators :: [(Text -> Bool, Text -> PackageNameError)]
validators =
[ (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null, forall a b. a -> b -> a
const PackageNameError
NotEmpty)
, ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
validChar, [Char] -> PackageNameError
InvalidChars forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
validChar))
, ((Char -> Bool) -> Text -> Bool
firstChar (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
dashOrDot), forall a b. a -> b -> a
const PackageNameError
MustNotBeginSeparator)
, ((Char -> Bool) -> Text -> Bool
lastChar (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
dashOrDot), forall a b. a -> b -> a
const PackageNameError
MustNotEndSeparator)
, (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isInfixOf Text
"--", forall a b. a -> b -> a
const PackageNameError
RepeatedSeparators)
, (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isInfixOf Text
"..", forall a b. a -> b -> a
const PackageNameError
RepeatedSeparators)
, (Text -> Int
T.length forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall a. Ord a => a -> a -> Bool
<= Int
50), Int -> PackageNameError
TooLong forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length)
]
firstChar :: (Char -> Bool) -> Text -> Bool
firstChar Char -> Bool
p Text
str = Bool -> Bool
not (Text -> Bool
T.null Text
str) Bool -> Bool -> Bool
&& Char -> Bool
p (Text -> Int -> Char
T.index Text
str Int
0)
lastChar :: (Char -> Bool) -> Text -> Bool
lastChar Char -> Bool
p = (Char -> Bool) -> Text -> Bool
firstChar Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse
data Author = Author
{ Author -> Text
authorName :: Text
, Author -> Maybe Text
authorEmail :: Maybe Text
, Author -> Maybe Text
authorHomepage :: Maybe Text
}
deriving (Int -> Author -> ShowS
[Author] -> ShowS
Author -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> [Char]
$cshow :: Author -> [Char]
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show, Author -> Author -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c== :: Author -> Author -> Bool
Eq, Eq Author
Author -> Author -> Bool
Author -> Author -> Ordering
Author -> Author -> Author
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 :: Author -> Author -> Author
$cmin :: Author -> Author -> Author
max :: Author -> Author -> Author
$cmax :: Author -> Author -> Author
>= :: Author -> Author -> Bool
$c>= :: Author -> Author -> Bool
> :: Author -> Author -> Bool
$c> :: Author -> Author -> Bool
<= :: Author -> Author -> Bool
$c<= :: Author -> Author -> Bool
< :: Author -> Author -> Bool
$c< :: Author -> Author -> Bool
compare :: Author -> Author -> Ordering
$ccompare :: Author -> Author -> Ordering
Ord, forall x. Rep Author x -> Author
forall x. Author -> Rep Author x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Author x -> Author
$cfrom :: forall x. Author -> Rep Author x
Generic)
instance NFData Author
data ModuleType
= Globals
| AMD
| Node
| ES6
| YUI
deriving (Int -> ModuleType -> ShowS
[ModuleType] -> ShowS
ModuleType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModuleType] -> ShowS
$cshowList :: [ModuleType] -> ShowS
show :: ModuleType -> [Char]
$cshow :: ModuleType -> [Char]
showsPrec :: Int -> ModuleType -> ShowS
$cshowsPrec :: Int -> ModuleType -> ShowS
Show, ModuleType -> ModuleType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleType -> ModuleType -> Bool
$c/= :: ModuleType -> ModuleType -> Bool
== :: ModuleType -> ModuleType -> Bool
$c== :: ModuleType -> ModuleType -> Bool
Eq, Eq ModuleType
ModuleType -> ModuleType -> Bool
ModuleType -> ModuleType -> Ordering
ModuleType -> ModuleType -> ModuleType
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 :: ModuleType -> ModuleType -> ModuleType
$cmin :: ModuleType -> ModuleType -> ModuleType
max :: ModuleType -> ModuleType -> ModuleType
$cmax :: ModuleType -> ModuleType -> ModuleType
>= :: ModuleType -> ModuleType -> Bool
$c>= :: ModuleType -> ModuleType -> Bool
> :: ModuleType -> ModuleType -> Bool
$c> :: ModuleType -> ModuleType -> Bool
<= :: ModuleType -> ModuleType -> Bool
$c<= :: ModuleType -> ModuleType -> Bool
< :: ModuleType -> ModuleType -> Bool
$c< :: ModuleType -> ModuleType -> Bool
compare :: ModuleType -> ModuleType -> Ordering
$ccompare :: ModuleType -> ModuleType -> Ordering
Ord, Int -> ModuleType
ModuleType -> Int
ModuleType -> [ModuleType]
ModuleType -> ModuleType
ModuleType -> ModuleType -> [ModuleType]
ModuleType -> ModuleType -> ModuleType -> [ModuleType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModuleType -> ModuleType -> ModuleType -> [ModuleType]
$cenumFromThenTo :: ModuleType -> ModuleType -> ModuleType -> [ModuleType]
enumFromTo :: ModuleType -> ModuleType -> [ModuleType]
$cenumFromTo :: ModuleType -> ModuleType -> [ModuleType]
enumFromThen :: ModuleType -> ModuleType -> [ModuleType]
$cenumFromThen :: ModuleType -> ModuleType -> [ModuleType]
enumFrom :: ModuleType -> [ModuleType]
$cenumFrom :: ModuleType -> [ModuleType]
fromEnum :: ModuleType -> Int
$cfromEnum :: ModuleType -> Int
toEnum :: Int -> ModuleType
$ctoEnum :: Int -> ModuleType
pred :: ModuleType -> ModuleType
$cpred :: ModuleType -> ModuleType
succ :: ModuleType -> ModuleType
$csucc :: ModuleType -> ModuleType
Enum, ModuleType
forall a. a -> a -> Bounded a
maxBound :: ModuleType
$cmaxBound :: ModuleType
minBound :: ModuleType
$cminBound :: ModuleType
Bounded, forall x. Rep ModuleType x -> ModuleType
forall x. ModuleType -> Rep ModuleType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleType x -> ModuleType
$cfrom :: forall x. ModuleType -> Rep ModuleType x
Generic)
instance NFData ModuleType
moduleTypes :: [(Text, ModuleType)]
moduleTypes :: [(Text, ModuleType)]
moduleTypes = forall a b. (a -> b) -> [a] -> [b]
map (\ModuleType
t -> (Text -> Text
T.toLower ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ModuleType
t)), ModuleType
t)) [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
data Repository = Repository
{ Repository -> Text
repositoryUrl :: Text
, Repository -> Text
repositoryType :: Text
}
deriving (Int -> Repository -> ShowS
[Repository] -> ShowS
Repository -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Repository] -> ShowS
$cshowList :: [Repository] -> ShowS
show :: Repository -> [Char]
$cshow :: Repository -> [Char]
showsPrec :: Int -> Repository -> ShowS
$cshowsPrec :: Int -> Repository -> ShowS
Show, Repository -> Repository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repository -> Repository -> Bool
$c/= :: Repository -> Repository -> Bool
== :: Repository -> Repository -> Bool
$c== :: Repository -> Repository -> Bool
Eq, Eq Repository
Repository -> Repository -> Bool
Repository -> Repository -> Ordering
Repository -> Repository -> Repository
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 :: Repository -> Repository -> Repository
$cmin :: Repository -> Repository -> Repository
max :: Repository -> Repository -> Repository
$cmax :: Repository -> Repository -> Repository
>= :: Repository -> Repository -> Bool
$c>= :: Repository -> Repository -> Bool
> :: Repository -> Repository -> Bool
$c> :: Repository -> Repository -> Bool
<= :: Repository -> Repository -> Bool
$c<= :: Repository -> Repository -> Bool
< :: Repository -> Repository -> Bool
$c< :: Repository -> Repository -> Bool
compare :: Repository -> Repository -> Ordering
$ccompare :: Repository -> Repository -> Ordering
Ord, forall x. Rep Repository x -> Repository
forall x. Repository -> Rep Repository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repository x -> Repository
$cfrom :: forall x. Repository -> Rep Repository x
Generic)
instance NFData Repository
newtype Version
= Version { Version -> Text
runVersion :: Text }
deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> [Char]
$cshow :: Version -> [Char]
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Version -> Version -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
Ord, forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)
instance NFData Version
newtype VersionRange
= VersionRange { VersionRange -> Text
runVersionRange :: Text }
deriving (Int -> VersionRange -> ShowS
[VersionRange] -> ShowS
VersionRange -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VersionRange] -> ShowS
$cshowList :: [VersionRange] -> ShowS
show :: VersionRange -> [Char]
$cshow :: VersionRange -> [Char]
showsPrec :: Int -> VersionRange -> ShowS
$cshowsPrec :: Int -> VersionRange -> ShowS
Show, VersionRange -> VersionRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionRange -> VersionRange -> Bool
$c/= :: VersionRange -> VersionRange -> Bool
== :: VersionRange -> VersionRange -> Bool
$c== :: VersionRange -> VersionRange -> Bool
Eq, Eq VersionRange
VersionRange -> VersionRange -> Bool
VersionRange -> VersionRange -> Ordering
VersionRange -> VersionRange -> VersionRange
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 :: VersionRange -> VersionRange -> VersionRange
$cmin :: VersionRange -> VersionRange -> VersionRange
max :: VersionRange -> VersionRange -> VersionRange
$cmax :: VersionRange -> VersionRange -> VersionRange
>= :: VersionRange -> VersionRange -> Bool
$c>= :: VersionRange -> VersionRange -> Bool
> :: VersionRange -> VersionRange -> Bool
$c> :: VersionRange -> VersionRange -> Bool
<= :: VersionRange -> VersionRange -> Bool
$c<= :: VersionRange -> VersionRange -> Bool
< :: VersionRange -> VersionRange -> Bool
$c< :: VersionRange -> VersionRange -> Bool
compare :: VersionRange -> VersionRange -> Ordering
$ccompare :: VersionRange -> VersionRange -> Ordering
Ord, forall x. Rep VersionRange x -> VersionRange
forall x. VersionRange -> Rep VersionRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VersionRange x -> VersionRange
$cfrom :: forall x. VersionRange -> Rep VersionRange x
Generic)
instance NFData VersionRange
data BowerError
= InvalidPackageName PackageNameError
| InvalidModuleType Text
deriving (Int -> BowerError -> ShowS
[BowerError] -> ShowS
BowerError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BowerError] -> ShowS
$cshowList :: [BowerError] -> ShowS
show :: BowerError -> [Char]
$cshow :: BowerError -> [Char]
showsPrec :: Int -> BowerError -> ShowS
$cshowsPrec :: Int -> BowerError -> ShowS
Show, BowerError -> BowerError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BowerError -> BowerError -> Bool
$c/= :: BowerError -> BowerError -> Bool
== :: BowerError -> BowerError -> Bool
$c== :: BowerError -> BowerError -> Bool
Eq, Eq BowerError
BowerError -> BowerError -> Bool
BowerError -> BowerError -> Ordering
BowerError -> BowerError -> BowerError
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 :: BowerError -> BowerError -> BowerError
$cmin :: BowerError -> BowerError -> BowerError
max :: BowerError -> BowerError -> BowerError
$cmax :: BowerError -> BowerError -> BowerError
>= :: BowerError -> BowerError -> Bool
$c>= :: BowerError -> BowerError -> Bool
> :: BowerError -> BowerError -> Bool
$c> :: BowerError -> BowerError -> Bool
<= :: BowerError -> BowerError -> Bool
$c<= :: BowerError -> BowerError -> Bool
< :: BowerError -> BowerError -> Bool
$c< :: BowerError -> BowerError -> Bool
compare :: BowerError -> BowerError -> Ordering
$ccompare :: BowerError -> BowerError -> Ordering
Ord, forall x. Rep BowerError x -> BowerError
forall x. BowerError -> Rep BowerError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BowerError x -> BowerError
$cfrom :: forall x. BowerError -> Rep BowerError x
Generic)
instance NFData BowerError
showBowerError :: BowerError -> Text
showBowerError :: BowerError -> Text
showBowerError (InvalidPackageName PackageNameError
err) =
Text
"Invalid package name: " forall a. Semigroup a => a -> a -> a
<> PackageNameError -> Text
showPackageNameError PackageNameError
err
showBowerError (InvalidModuleType Text
str) =
Text
"Invalid module type: " forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<>
Text
". Must be one of: " forall a. Semigroup a => a -> a -> a
<> forall {b}. [(Text, b)] -> Text
renderList [(Text, ModuleType)]
moduleTypes
where
renderList :: [(Text, b)] -> Text
renderList =
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text] -> Text
T.intercalate Text
", "
data PackageNameError
= NotEmpty
| TooLong Int
| InvalidChars [Char]
| RepeatedSeparators
| MustNotBeginSeparator
| MustNotEndSeparator
deriving (Int -> PackageNameError -> ShowS
[PackageNameError] -> ShowS
PackageNameError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageNameError] -> ShowS
$cshowList :: [PackageNameError] -> ShowS
show :: PackageNameError -> [Char]
$cshow :: PackageNameError -> [Char]
showsPrec :: Int -> PackageNameError -> ShowS
$cshowsPrec :: Int -> PackageNameError -> ShowS
Show, PackageNameError -> PackageNameError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageNameError -> PackageNameError -> Bool
$c/= :: PackageNameError -> PackageNameError -> Bool
== :: PackageNameError -> PackageNameError -> Bool
$c== :: PackageNameError -> PackageNameError -> Bool
Eq, Eq PackageNameError
PackageNameError -> PackageNameError -> Bool
PackageNameError -> PackageNameError -> Ordering
PackageNameError -> PackageNameError -> PackageNameError
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 :: PackageNameError -> PackageNameError -> PackageNameError
$cmin :: PackageNameError -> PackageNameError -> PackageNameError
max :: PackageNameError -> PackageNameError -> PackageNameError
$cmax :: PackageNameError -> PackageNameError -> PackageNameError
>= :: PackageNameError -> PackageNameError -> Bool
$c>= :: PackageNameError -> PackageNameError -> Bool
> :: PackageNameError -> PackageNameError -> Bool
$c> :: PackageNameError -> PackageNameError -> Bool
<= :: PackageNameError -> PackageNameError -> Bool
$c<= :: PackageNameError -> PackageNameError -> Bool
< :: PackageNameError -> PackageNameError -> Bool
$c< :: PackageNameError -> PackageNameError -> Bool
compare :: PackageNameError -> PackageNameError -> Ordering
$ccompare :: PackageNameError -> PackageNameError -> Ordering
Ord, forall x. Rep PackageNameError x -> PackageNameError
forall x. PackageNameError -> Rep PackageNameError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageNameError x -> PackageNameError
$cfrom :: forall x. PackageNameError -> Rep PackageNameError x
Generic)
instance NFData PackageNameError
showPackageNameError :: PackageNameError -> Text
showPackageNameError :: PackageNameError -> Text
showPackageNameError PackageNameError
err = case PackageNameError
err of
PackageNameError
NotEmpty ->
Text
"A package name may not be empty"
TooLong Int
x ->
Text
"Package names must be no more than 50 characters, yours was " forall a. Semigroup a => a -> a -> a
<>
[Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
x)
InvalidChars [Char]
chars ->
Text
"The following characters are not permitted in package names: " forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate Text
" " (forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char]
chars)
PackageNameError
RepeatedSeparators ->
Text
"The substrings \"--\" and \"..\" may not appear in "forall a. Semigroup a => a -> a -> a
<>
Text
"package names"
PackageNameError
MustNotBeginSeparator ->
Text
"Package names may not begin with a dash or a dot"
PackageNameError
MustNotEndSeparator ->
Text
"Package names may not end with a dash or a dot"
displayError :: ParseError BowerError -> Text
displayError :: ParseError BowerError -> Text
displayError = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err. (err -> Text) -> ParseError err -> [Text]
Data.Aeson.BetterErrors.displayError BowerError -> Text
showBowerError
decodeFile :: FilePath -> IO (Either (ParseError BowerError) PackageMeta)
decodeFile :: [Char] -> IO (Either (ParseError BowerError) PackageMeta)
decodeFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall err a.
Parse err a -> ByteString -> Either (ParseError err) a
parse Parse BowerError PackageMeta
asPackageMeta) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ByteString
B.readFile
asPackageMeta :: Parse BowerError PackageMeta
asPackageMeta :: Parse BowerError PackageMeta
asPackageMeta =
PackageName
-> Maybe Text
-> [[Char]]
-> [ModuleType]
-> [Text]
-> [Text]
-> [Text]
-> [Author]
-> Maybe Text
-> Maybe Repository
-> [(PackageName, VersionRange)]
-> [(PackageName, VersionRange)]
-> [(PackageName, Version)]
-> Bool
-> PackageMeta
PackageMeta forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"name" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText Text -> Either BowerError PackageName
parsePackageName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"main" [] (forall e a. Parse e a -> Parse e [a]
arrayOrSingle forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m [Char]
asString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"moduleType" [] (forall e a. Parse e a -> Parse e [a]
arrayOrSingle (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText Text -> Either BowerError ModuleType
parseModuleType))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"license" [] (forall e a. Parse e a -> Parse e [a]
arrayOrSingle forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"ignore" [] (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"keywords" [] (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"authors" [] (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall e. Parse e Author
asAuthor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
"homepage" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
"repository" forall e. Parse e Repository
asRepository
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"dependencies" [] (forall a. (Text -> a) -> Parse BowerError [(PackageName, a)]
asAssocListOf Text -> VersionRange
VersionRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"devDependencies" [] (forall a. (Text -> a) -> Parse BowerError [(PackageName, a)]
asAssocListOf Text -> VersionRange
VersionRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"resolutions" [] (forall a. (Text -> a) -> Parse BowerError [(PackageName, a)]
asAssocListOf Text -> Version
Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"private" Bool
False forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Bool
asBool
where
arrayOrSingle :: Parse e a -> Parse e [a]
arrayOrSingle :: forall e a. Parse e a -> Parse e [a]
arrayOrSingle Parse e a
parser =
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) Parse e a
parser) forall {e} {m :: * -> *} {a}. MonadError e m => m a -> m a -> m a
<|> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse e a
parser
where
<|> :: m a -> m a -> m a
(<|>) m a
p m a
q = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m a
p (forall a b. a -> b -> a
const m a
q)
asAssocListOf :: (Text -> a) -> Parse BowerError [(PackageName, a)]
asAssocListOf :: forall a. (Text -> a) -> Parse BowerError [(PackageName, a)]
asAssocListOf Text -> a
g =
forall (m :: * -> *) err k a.
(Functor m, Monad m) =>
(Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey Text -> Either BowerError PackageName
parsePackageName (Text -> a
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
parseModuleType :: Text -> Either BowerError ModuleType
parseModuleType :: Text -> Either BowerError ModuleType
parseModuleType Text
str =
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
str [(Text, ModuleType)]
moduleTypes of
Maybe ModuleType
Nothing -> forall a b. a -> Either a b
Left (Text -> BowerError
InvalidModuleType Text
str)
Just ModuleType
mt -> forall a b. b -> Either a b
Right ModuleType
mt
parsePackageName :: Text -> Either BowerError PackageName
parsePackageName :: Text -> Either BowerError PackageName
parsePackageName Text
str =
case Text -> Either PackageNameError PackageName
mkPackageName Text
str of
Left PackageNameError
err -> forall a b. a -> Either a b
Left (PackageNameError -> BowerError
InvalidPackageName PackageNameError
err)
Right PackageName
n -> forall a b. b -> Either a b
Right PackageName
n
asAuthor :: Parse e Author
asAuthor :: forall e. Parse e Author
asAuthor = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError forall e. Parse e Author
asAuthorString (forall a b. a -> b -> a
const forall e. Parse e Author
asAuthorObject)
asAuthorString :: Parse e Author
asAuthorString :: forall e. Parse e Author
asAuthorString = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText forall a b. (a -> b) -> a -> b
$ \Text
s ->
let (Maybe Text
email, [Text]
s1) = Text -> Text -> [Text] -> (Maybe Text, [Text])
takeDelim Text
"<" Text
">" (Text -> [Text]
T.words Text
s)
(Maybe Text
homepage, [Text]
s2) = Text -> Text -> [Text] -> (Maybe Text, [Text])
takeDelim Text
"(" Text
")" [Text]
s1
in forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text -> Maybe Text -> Author
Author ([Text] -> Text
T.unwords [Text]
s2) Maybe Text
email Maybe Text
homepage)
takeDelim :: Text -> Text -> [Text] -> (Maybe Text, [Text])
takeDelim :: Text -> Text -> [Text] -> (Maybe Text, [Text])
takeDelim Text
start Text
end = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> (Maybe Text, [Text]) -> (Maybe Text, [Text])
go (forall a. Maybe a
Nothing, [])
where
go :: Text -> (Maybe Text, [Text]) -> (Maybe Text, [Text])
go Text
str (Just Text
x, [Text]
strs) =
(forall a. a -> Maybe a
Just Text
x, Text
str forall a. a -> [a] -> [a]
: [Text]
strs)
go Text
str (Maybe Text
Nothing, [Text]
strs) =
case Text -> Text -> Text -> Maybe Text
stripWrapper Text
start Text
end Text
str of
Just Text
str' -> (forall a. a -> Maybe a
Just Text
str', [Text]
strs)
Maybe Text
Nothing -> (forall a. Maybe a
Nothing, Text
str forall a. a -> [a] -> [a]
: [Text]
strs)
stripWrapper :: Text -> Text -> Text -> Maybe Text
stripWrapper :: Text -> Text -> Text -> Maybe Text
stripWrapper Text
start Text
end =
Text -> Text -> Maybe Text
T.stripPrefix Text
start
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.reverse
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Text -> Maybe Text
T.stripPrefix (Text -> Text
T.reverse Text
end)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.reverse
asAuthorObject :: Parse e Author
asAuthorObject :: forall e. Parse e Author
asAuthorObject =
Text -> Maybe Text -> Maybe Text -> Author
Author forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
"email" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
"homepage" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
asRepository :: Parse e Repository
asRepository :: forall e. Parse e Repository
asRepository =
Text -> Text -> Repository
Repository forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"url" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"type" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
instance A.ToJSON PackageMeta where
toJSON :: PackageMeta -> Value
toJSON PackageMeta{Bool
[[Char]]
[(PackageName, VersionRange)]
[(PackageName, Version)]
[Text]
[ModuleType]
[Author]
Maybe Text
Maybe Repository
PackageName
bowerPrivate :: Bool
bowerResolutions :: [(PackageName, Version)]
bowerDevDependencies :: [(PackageName, VersionRange)]
bowerDependencies :: [(PackageName, VersionRange)]
bowerRepository :: Maybe Repository
bowerHomepage :: Maybe Text
bowerAuthors :: [Author]
bowerKeywords :: [Text]
bowerIgnore :: [Text]
bowerLicense :: [Text]
bowerModuleType :: [ModuleType]
bowerMain :: [[Char]]
bowerDescription :: Maybe Text
bowerName :: PackageName
bowerPrivate :: PackageMeta -> Bool
bowerResolutions :: PackageMeta -> [(PackageName, Version)]
bowerDevDependencies :: PackageMeta -> [(PackageName, VersionRange)]
bowerDependencies :: PackageMeta -> [(PackageName, VersionRange)]
bowerRepository :: PackageMeta -> Maybe Repository
bowerHomepage :: PackageMeta -> Maybe Text
bowerAuthors :: PackageMeta -> [Author]
bowerKeywords :: PackageMeta -> [Text]
bowerIgnore :: PackageMeta -> [Text]
bowerLicense :: PackageMeta -> [Text]
bowerModuleType :: PackageMeta -> [ModuleType]
bowerMain :: PackageMeta -> [[Char]]
bowerDescription :: PackageMeta -> Maybe Text
bowerName :: PackageMeta -> PackageName
..} =
[Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PackageName
bowerName ]
, forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"description" Maybe Text
bowerDescription
, forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"main" [[Char]]
bowerMain
, forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"moduleType" [ModuleType]
bowerModuleType
, forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"license" [Text]
bowerLicense
, forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"ignore" [Text]
bowerIgnore
, forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"keywords" [Text]
bowerKeywords
, forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"authors" [Author]
bowerAuthors
, forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"homepage" Maybe Text
bowerHomepage
, forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"repository" Maybe Repository
bowerRepository
, forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc Key
"dependencies" [(PackageName, VersionRange)]
bowerDependencies
, forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc Key
"devDependencies" [(PackageName, VersionRange)]
bowerDevDependencies
, forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc Key
"resolutions" [(PackageName, Version)]
bowerResolutions
, if Bool
bowerPrivate then [ Key
"private" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True ] else []
]
where
assoc :: A.ToJSON a => A.Key -> [(PackageName, a)] -> [Aeson.Pair]
assoc :: forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc = forall b a. ToJSON b => (a -> Key) -> Key -> [(a, b)] -> [Pair]
maybeArrayAssocPair (Text -> Key
A.Key.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
runPackageName)
instance A.ToJSON PackageName where
toJSON :: PackageName -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
runPackageName
instance A.ToJSON ModuleType where
toJSON :: ModuleType -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
instance A.ToJSON Repository where
toJSON :: Repository -> Value
toJSON Repository{Text
repositoryType :: Text
repositoryUrl :: Text
repositoryType :: Repository -> Text
repositoryUrl :: Repository -> Text
..} =
[Pair] -> Value
A.object [ Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
repositoryUrl
, Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
repositoryType
]
instance A.ToJSON Author where
toJSON :: Author -> Value
toJSON Author{Maybe Text
Text
authorHomepage :: Maybe Text
authorEmail :: Maybe Text
authorName :: Text
authorHomepage :: Author -> Maybe Text
authorEmail :: Author -> Maybe Text
authorName :: Author -> Text
..} =
[Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$
[ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
authorName ] forall a. [a] -> [a] -> [a]
++
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"email" Maybe Text
authorEmail forall a. [a] -> [a] -> [a]
++
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"homepage" Maybe Text
authorHomepage
instance A.ToJSON Version where
toJSON :: Version -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
runVersion
instance A.ToJSON VersionRange where
toJSON :: VersionRange -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> Text
runVersionRange
maybePair :: A.ToJSON a => A.Key -> Maybe a -> [Aeson.Pair]
maybePair :: forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
k = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\a
val -> [Key
k forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
val])
maybeArrayPair :: A.ToJSON a => A.Key -> [a] -> [Aeson.Pair]
maybeArrayPair :: forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
_ [] = []
maybeArrayPair Key
k [a]
xs = [Key
k forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [a]
xs]
maybeArrayAssocPair :: A.ToJSON b => (a -> A.Key) -> A.Key -> [(a,b)] -> [Aeson.Pair]
maybeArrayAssocPair :: forall b a. ToJSON b => (a -> Key) -> Key -> [(a, b)] -> [Pair]
maybeArrayAssocPair a -> Key
_ Key
_ [] = []
maybeArrayAssocPair a -> Key
f Key
k [(a, b)]
xs = [Key
k forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
A.object (forall a b. (a -> b) -> [a] -> [b]
map (\(a
k', b
v) -> a -> Key
f a
k' forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= b
v) [(a, b)]
xs)]
instance A.FromJSON PackageMeta where
parseJSON :: Value -> Parser PackageMeta
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser BowerError -> Text
showBowerError Parse BowerError PackageMeta
asPackageMeta
instance A.FromJSON PackageName where
parseJSON :: Value -> Parser PackageName
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser BowerError -> Text
showBowerError (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText Text -> Either BowerError PackageName
parsePackageName)
instance A.FromJSON ModuleType where
parseJSON :: Value -> Parser ModuleType
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser BowerError -> Text
showBowerError (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText Text -> Either BowerError ModuleType
parseModuleType)
instance A.FromJSON Repository where
parseJSON :: Value -> Parser Repository
parseJSON = forall a. Parse' a -> Value -> Parser a
toAesonParser' forall e. Parse e Repository
asRepository
instance A.FromJSON Author where
parseJSON :: Value -> Parser Author
parseJSON = forall a. Parse' a -> Value -> Parser a
toAesonParser' forall e. Parse e Author
asAuthor
instance A.FromJSON Version where
parseJSON :: Value -> Parser Version
parseJSON = forall a. Parse' a -> Value -> Parser a
toAesonParser' (Text -> Version
Version forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
instance A.FromJSON VersionRange where
parseJSON :: Value -> Parser VersionRange
parseJSON = forall a. Parse' a -> Value -> Parser a
toAesonParser' (Text -> VersionRange
VersionRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)