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