{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}

-- | A data type representing the Bower.json package description file, together

-- with a parser and related functions.

--

-- This code is based on the specification at

-- <https://github.com/bower/bower.json-spec>.


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 types


-- | A data type representing the data stored in a bower.json package manifest

-- file.

--

-- Note that the 'ToJSON' / 'FromJSON' instances don't exactly match; for

-- example, it is not always the case that decoding from JSON and then encoding

-- to JSON will give you the exact same JSON that you started with. However, if

-- you start with a PackageMeta value, encode to JSON, and then decode, you

-- should always get the same value back.

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
$cshowsPrec :: Int -> PackageMeta -> ShowS
showsPrec :: Int -> PackageMeta -> ShowS
$cshow :: PackageMeta -> FilePath
show :: PackageMeta -> FilePath
$cshowList :: [PackageMeta] -> ShowS
showList :: [PackageMeta] -> ShowS
Show, PackageMeta -> PackageMeta -> Bool
(PackageMeta -> PackageMeta -> Bool)
-> (PackageMeta -> PackageMeta -> Bool) -> Eq PackageMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageMeta -> PackageMeta -> Bool
== :: PackageMeta -> PackageMeta -> Bool
$c/= :: PackageMeta -> PackageMeta -> Bool
/= :: 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
$ccompare :: PackageMeta -> PackageMeta -> Ordering
compare :: PackageMeta -> PackageMeta -> Ordering
$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
>= :: PackageMeta -> PackageMeta -> Bool
$cmax :: PackageMeta -> PackageMeta -> PackageMeta
max :: PackageMeta -> PackageMeta -> PackageMeta
$cmin :: PackageMeta -> PackageMeta -> PackageMeta
min :: PackageMeta -> PackageMeta -> 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
$cfrom :: forall x. PackageMeta -> Rep PackageMeta x
from :: forall x. PackageMeta -> Rep PackageMeta x
$cto :: forall x. Rep PackageMeta x -> PackageMeta
to :: forall x. Rep PackageMeta x -> PackageMeta
Generic)

instance NFData PackageMeta

-- | A valid package name for a Bower package.

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
$cshowsPrec :: Int -> PackageName -> ShowS
showsPrec :: Int -> PackageName -> ShowS
$cshow :: PackageName -> FilePath
show :: PackageName -> FilePath
$cshowList :: [PackageName] -> ShowS
showList :: [PackageName] -> ShowS
Show, PackageName -> PackageName -> Bool
(PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool) -> Eq PackageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageName -> PackageName -> Bool
== :: PackageName -> PackageName -> Bool
$c/= :: PackageName -> PackageName -> Bool
/= :: 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
$ccompare :: PackageName -> PackageName -> Ordering
compare :: PackageName -> PackageName -> Ordering
$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
>= :: PackageName -> PackageName -> Bool
$cmax :: PackageName -> PackageName -> PackageName
max :: PackageName -> PackageName -> PackageName
$cmin :: PackageName -> PackageName -> PackageName
min :: PackageName -> PackageName -> 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
$cfrom :: forall x. PackageName -> Rep PackageName x
from :: forall x. PackageName -> Rep PackageName x
$cto :: forall x. Rep PackageName x -> PackageName
to :: forall x. Rep PackageName x -> PackageName
Generic)

instance NFData PackageName

runPackageName :: PackageName -> Text
runPackageName :: PackageName -> Text
runPackageName (PackageName Text
s) = Text
s

-- | A smart constructor for a PackageName. It ensures that the package name

-- satisfies the restrictions described at

-- <https://github.com/bower/bower.json-spec#name>.

mkPackageName :: Text -> Either PackageNameError PackageName
mkPackageName :: Text -> Either PackageNameError PackageName
mkPackageName = (Text -> PackageName)
-> Either PackageNameError Text
-> Either PackageNameError PackageName
forall a b.
(a -> b) -> Either PackageNameError a -> Either PackageNameError b
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 = [Char
'-', Char
'.']
  validateAll :: t (b -> Bool, b -> a) -> b -> Either a b
validateAll t (b -> Bool, b -> a)
vs 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 a b. Either a a -> Either a b -> Either a b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Either a b
forall a. a -> Either a a
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       = 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 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 a. Eq a => a -> [a] -> 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 Text
"--", 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 Text
"..", 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
<= Int
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 Char -> Bool
p Text
str = Bool -> Bool
not (Text -> Bool
T.null Text
str) Bool -> Bool -> Bool
&& Char -> Bool
p (HasCallStack => Text -> Int -> Char
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 (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
$cshowsPrec :: Int -> Author -> ShowS
showsPrec :: Int -> Author -> ShowS
$cshow :: Author -> FilePath
show :: Author -> FilePath
$cshowList :: [Author] -> ShowS
showList :: [Author] -> ShowS
Show, Author -> Author -> Bool
(Author -> Author -> Bool)
-> (Author -> Author -> Bool) -> Eq Author
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
/= :: 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
$ccompare :: Author -> Author -> Ordering
compare :: Author -> Author -> Ordering
$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
>= :: Author -> Author -> Bool
$cmax :: Author -> Author -> Author
max :: Author -> Author -> Author
$cmin :: Author -> Author -> Author
min :: Author -> Author -> 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
$cfrom :: forall x. Author -> Rep Author x
from :: forall x. Author -> Rep Author x
$cto :: forall x. Rep Author x -> Author
to :: forall x. Rep Author x -> Author
Generic)

instance NFData Author

-- | See: <https://github.com/bower/bower.json-spec#moduletype>

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
$cshowsPrec :: Int -> ModuleType -> ShowS
showsPrec :: Int -> ModuleType -> ShowS
$cshow :: ModuleType -> FilePath
show :: ModuleType -> FilePath
$cshowList :: [ModuleType] -> ShowS
showList :: [ModuleType] -> ShowS
Show, ModuleType -> ModuleType -> Bool
(ModuleType -> ModuleType -> Bool)
-> (ModuleType -> ModuleType -> Bool) -> Eq ModuleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleType -> ModuleType -> Bool
== :: ModuleType -> ModuleType -> Bool
$c/= :: ModuleType -> ModuleType -> Bool
/= :: 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
$ccompare :: ModuleType -> ModuleType -> Ordering
compare :: ModuleType -> ModuleType -> Ordering
$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
>= :: ModuleType -> ModuleType -> Bool
$cmax :: ModuleType -> ModuleType -> ModuleType
max :: ModuleType -> ModuleType -> ModuleType
$cmin :: ModuleType -> ModuleType -> ModuleType
min :: ModuleType -> ModuleType -> 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
$csucc :: ModuleType -> ModuleType
succ :: ModuleType -> ModuleType
$cpred :: ModuleType -> ModuleType
pred :: ModuleType -> ModuleType
$ctoEnum :: Int -> ModuleType
toEnum :: Int -> ModuleType
$cfromEnum :: ModuleType -> Int
fromEnum :: ModuleType -> Int
$cenumFrom :: ModuleType -> [ModuleType]
enumFrom :: ModuleType -> [ModuleType]
$cenumFromThen :: ModuleType -> ModuleType -> [ModuleType]
enumFromThen :: ModuleType -> ModuleType -> [ModuleType]
$cenumFromTo :: ModuleType -> ModuleType -> [ModuleType]
enumFromTo :: ModuleType -> ModuleType -> [ModuleType]
$cenumFromThenTo :: ModuleType -> ModuleType -> ModuleType -> [ModuleType]
enumFromThenTo :: ModuleType -> ModuleType -> ModuleType -> [ModuleType]
Enum, ModuleType
ModuleType -> ModuleType -> Bounded ModuleType
forall a. a -> a -> Bounded a
$cminBound :: ModuleType
minBound :: ModuleType
$cmaxBound :: ModuleType
maxBound :: 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
$cfrom :: forall x. ModuleType -> Rep ModuleType x
from :: forall x. ModuleType -> Rep ModuleType x
$cto :: forall x. Rep ModuleType x -> ModuleType
to :: forall x. Rep ModuleType x -> ModuleType
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 (\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
$cshowsPrec :: Int -> Repository -> ShowS
showsPrec :: Int -> Repository -> ShowS
$cshow :: Repository -> FilePath
show :: Repository -> FilePath
$cshowList :: [Repository] -> ShowS
showList :: [Repository] -> ShowS
Show, Repository -> Repository -> Bool
(Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool) -> Eq Repository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repository -> Repository -> Bool
== :: Repository -> Repository -> Bool
$c/= :: Repository -> Repository -> Bool
/= :: 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
$ccompare :: Repository -> Repository -> Ordering
compare :: Repository -> Repository -> Ordering
$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
>= :: Repository -> Repository -> Bool
$cmax :: Repository -> Repository -> Repository
max :: Repository -> Repository -> Repository
$cmin :: Repository -> Repository -> Repository
min :: Repository -> Repository -> 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
$cfrom :: forall x. Repository -> Rep Repository x
from :: forall x. Repository -> Rep Repository x
$cto :: forall x. Rep Repository x -> Repository
to :: forall x. Rep Repository x -> Repository
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
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> FilePath
show :: Version -> FilePath
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: 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
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$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
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> 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
$cfrom :: forall x. Version -> Rep Version x
from :: forall x. Version -> Rep Version x
$cto :: forall x. Rep Version x -> Version
to :: forall x. Rep Version x -> Version
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
$cshowsPrec :: Int -> VersionRange -> ShowS
showsPrec :: Int -> VersionRange -> ShowS
$cshow :: VersionRange -> FilePath
show :: VersionRange -> FilePath
$cshowList :: [VersionRange] -> ShowS
showList :: [VersionRange] -> ShowS
Show, VersionRange -> VersionRange -> Bool
(VersionRange -> VersionRange -> Bool)
-> (VersionRange -> VersionRange -> Bool) -> Eq VersionRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionRange -> VersionRange -> Bool
== :: VersionRange -> VersionRange -> Bool
$c/= :: VersionRange -> VersionRange -> Bool
/= :: 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
$ccompare :: VersionRange -> VersionRange -> Ordering
compare :: VersionRange -> VersionRange -> Ordering
$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
>= :: VersionRange -> VersionRange -> Bool
$cmax :: VersionRange -> VersionRange -> VersionRange
max :: VersionRange -> VersionRange -> VersionRange
$cmin :: VersionRange -> VersionRange -> VersionRange
min :: VersionRange -> VersionRange -> 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
$cfrom :: forall x. VersionRange -> Rep VersionRange x
from :: forall x. VersionRange -> Rep VersionRange x
$cto :: forall x. Rep VersionRange x -> VersionRange
to :: forall x. Rep VersionRange x -> VersionRange
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
$cshowsPrec :: Int -> BowerError -> ShowS
showsPrec :: Int -> BowerError -> ShowS
$cshow :: BowerError -> FilePath
show :: BowerError -> FilePath
$cshowList :: [BowerError] -> ShowS
showList :: [BowerError] -> ShowS
Show, BowerError -> BowerError -> Bool
(BowerError -> BowerError -> Bool)
-> (BowerError -> BowerError -> Bool) -> Eq BowerError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BowerError -> BowerError -> Bool
== :: BowerError -> BowerError -> Bool
$c/= :: BowerError -> BowerError -> Bool
/= :: 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
$ccompare :: BowerError -> BowerError -> Ordering
compare :: BowerError -> BowerError -> Ordering
$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
>= :: BowerError -> BowerError -> Bool
$cmax :: BowerError -> BowerError -> BowerError
max :: BowerError -> BowerError -> BowerError
$cmin :: BowerError -> BowerError -> BowerError
min :: BowerError -> BowerError -> 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
$cfrom :: forall x. BowerError -> Rep BowerError x
from :: forall x. BowerError -> Rep BowerError x
$cto :: forall x. Rep BowerError x -> BowerError
to :: forall x. Rep BowerError x -> BowerError
Generic)

instance NFData BowerError

showBowerError :: BowerError -> Text
showBowerError :: BowerError -> Text
showBowerError (InvalidPackageName PackageNameError
err) =
  Text
"Invalid package name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PackageNameError -> Text
showPackageNameError PackageNameError
err
showBowerError (InvalidModuleType Text
str) =
  Text
"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
<>
    Text
". 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 Text
", "

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
$cshowsPrec :: Int -> PackageNameError -> ShowS
showsPrec :: Int -> PackageNameError -> ShowS
$cshow :: PackageNameError -> FilePath
show :: PackageNameError -> FilePath
$cshowList :: [PackageNameError] -> ShowS
showList :: [PackageNameError] -> ShowS
Show, PackageNameError -> PackageNameError -> Bool
(PackageNameError -> PackageNameError -> Bool)
-> (PackageNameError -> PackageNameError -> Bool)
-> Eq PackageNameError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageNameError -> PackageNameError -> Bool
== :: PackageNameError -> PackageNameError -> Bool
$c/= :: PackageNameError -> PackageNameError -> Bool
/= :: 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
$ccompare :: PackageNameError -> PackageNameError -> Ordering
compare :: PackageNameError -> PackageNameError -> Ordering
$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
>= :: PackageNameError -> PackageNameError -> Bool
$cmax :: PackageNameError -> PackageNameError -> PackageNameError
max :: PackageNameError -> PackageNameError -> PackageNameError
$cmin :: PackageNameError -> PackageNameError -> PackageNameError
min :: PackageNameError -> PackageNameError -> 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
$cfrom :: forall x. PackageNameError -> Rep PackageNameError x
from :: forall x. PackageNameError -> Rep PackageNameError x
$cto :: forall x. Rep PackageNameError x -> PackageNameError
to :: forall x. Rep PackageNameError x -> PackageNameError
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 " 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 FilePath
chars ->
    Text
"The following characters are not permitted in package names: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text -> [Text] -> Text
T.intercalate Text
" " ((Char -> Text) -> FilePath -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton FilePath
chars)
  PackageNameError
RepeatedSeparators ->
    Text
"The substrings \"--\" and \"..\" may not appear in "Text -> Text -> Text
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 ([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

-------------------------

-- Parsing


-- | Read and attempt to decode a bower.json file.

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 a b. (a -> b) -> IO a -> IO b
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

-- | A parser for bower.json files, using the aeson-better-errors package.

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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 a b.
ParseT BowerError Identity (a -> b)
-> ParseT BowerError Identity a -> ParseT BowerError Identity b
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 Text
"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 :: forall e a. Parse e a -> Parse e [a]
arrayOrSingle Parse e a
parser =
    ((a -> [a]) -> Parse e a -> ParseT e Identity [a]
forall a b. (a -> b) -> ParseT e Identity a -> ParseT e Identity b
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) ParseT e Identity [a]
-> ParseT e Identity [a] -> ParseT e Identity [a]
forall {e} {m :: * -> *} {a}. MonadError e m => m a -> m a -> m a
<|> Parse e a -> ParseT e Identity [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 = m a -> (e -> m a) -> m a
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m a
p (m a -> e -> m a
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 =
    (Text -> Either BowerError PackageName)
-> ParseT BowerError Identity a
-> ParseT BowerError Identity [(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 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
    Maybe ModuleType
Nothing -> BowerError -> Either BowerError ModuleType
forall a b. a -> Either a b
Left (Text -> BowerError
InvalidModuleType Text
str)
    Just 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 Text
str =
  case Text -> Either PackageNameError PackageName
mkPackageName Text
str of
    Left PackageNameError
err -> BowerError -> Either BowerError PackageName
forall a b. a -> Either a b
Left (PackageNameError -> BowerError
InvalidPackageName PackageNameError
err)
    Right PackageName
n -> PackageName -> Either BowerError PackageName
forall a b. b -> Either a b
Right PackageName
n

asAuthor :: Parse e Author
asAuthor :: forall e. Parse e Author
asAuthor = ParseT e Identity Author
-> (ParseError e -> ParseT e Identity Author)
-> ParseT e Identity Author
forall a.
ParseT e Identity a
-> (ParseError e -> ParseT e Identity a) -> ParseT e Identity a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ParseT e Identity Author
forall e. Parse e Author
asAuthorString (ParseT e Identity Author
-> ParseError e -> ParseT e Identity Author
forall a b. a -> b -> a
const ParseT e Identity Author
forall e. Parse e Author
asAuthorObject)

asAuthorString :: Parse e Author
asAuthorString :: forall e. Parse e Author
asAuthorString = (Text -> Either e Author) -> ParseT e Identity Author
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText ((Text -> Either e Author) -> ParseT e Identity Author)
-> (Text -> Either e Author) -> ParseT e Identity Author
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 Author -> Either e Author
forall a. a -> Either e a
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)

-- | Given a prefix and a suffix, go through the supplied list, attempting

-- to extract one string from the list which has the given prefix and suffix,

-- All other strings in the list are returned as the second component of the

-- tuple.

takeDelim :: Text -> Text -> [Text] -> (Maybe Text, [Text])
takeDelim :: Text -> Text -> [Text] -> (Maybe Text, [Text])
takeDelim Text
start Text
end = (Text -> (Maybe Text, [Text]) -> (Maybe Text, [Text]))
-> (Maybe Text, [Text]) -> [Text] -> (Maybe Text, [Text])
forall a b. (a -> b -> b) -> b -> [a] -> b
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 Text
str (Just Text
x, [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 Text
str (Maybe Text
Nothing, [Text]
strs) =
    case Text -> Text -> Text -> Maybe Text
stripWrapper Text
start Text
end Text
str of
      Just Text
str' -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
str', [Text]
strs)
      Maybe Text
Nothing   -> (Maybe Text
forall a. Maybe a
Nothing, Text
str Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
strs)

-- | Like stripPrefix, but strips a suffix as well.

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
    (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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 (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 Text
"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 a b.
ParseT e Identity (a -> b)
-> ParseT e Identity a -> ParseT e Identity b
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 Text
"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) -> ParseT e Identity Author
forall a b.
ParseT e Identity (a -> b)
-> ParseT e Identity a -> ParseT e Identity b
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 Text
"homepage" ParseT e Identity Text
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 (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 Text
"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 -> ParseT e Identity Repository
forall a b.
ParseT e Identity (a -> b)
-> ParseT e Identity a -> ParseT e Identity b
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 Text
"type" ParseT e Identity Text
forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText

------------------------

-- Serializing


instance A.ToJSON PackageMeta where
  toJSON :: PackageMeta -> Value
toJSON PackageMeta{Bool
[FilePath]
[(PackageName, VersionRange)]
[(PackageName, Version)]
[Text]
[ModuleType]
[Author]
Maybe Text
Maybe Repository
PackageName
bowerName :: PackageMeta -> PackageName
bowerDescription :: PackageMeta -> Maybe Text
bowerMain :: PackageMeta -> [FilePath]
bowerModuleType :: PackageMeta -> [ModuleType]
bowerLicense :: PackageMeta -> [Text]
bowerIgnore :: PackageMeta -> [Text]
bowerKeywords :: PackageMeta -> [Text]
bowerAuthors :: PackageMeta -> [Author]
bowerHomepage :: PackageMeta -> Maybe Text
bowerRepository :: PackageMeta -> Maybe Repository
bowerDependencies :: PackageMeta -> [(PackageName, VersionRange)]
bowerDevDependencies :: PackageMeta -> [(PackageName, VersionRange)]
bowerResolutions :: PackageMeta -> [(PackageName, Version)]
bowerPrivate :: PackageMeta -> Bool
bowerName :: PackageName
bowerDescription :: Maybe Text
bowerMain :: [FilePath]
bowerModuleType :: [ModuleType]
bowerLicense :: [Text]
bowerIgnore :: [Text]
bowerKeywords :: [Text]
bowerAuthors :: [Author]
bowerHomepage :: Maybe Text
bowerRepository :: Maybe Repository
bowerDependencies :: [(PackageName, VersionRange)]
bowerDevDependencies :: [(PackageName, VersionRange)]
bowerResolutions :: [(PackageName, Version)]
bowerPrivate :: Bool
..} =
    [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
      [ [ Key
"name" Key -> PackageName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PackageName
bowerName ]
      , Key -> Maybe Text -> [Pair]
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"description" Maybe Text
bowerDescription
      , Key -> [FilePath] -> [Pair]
forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"main" [FilePath]
bowerMain
      , Key -> [ModuleType] -> [Pair]
forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"moduleType" [ModuleType]
bowerModuleType
      , Key -> [Text] -> [Pair]
forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"license" [Text]
bowerLicense
      , Key -> [Text] -> [Pair]
forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"ignore" [Text]
bowerIgnore
      , Key -> [Text] -> [Pair]
forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"keywords" [Text]
bowerKeywords
      , Key -> [Author] -> [Pair]
forall a. ToJSON a => Key -> [a] -> [Pair]
maybeArrayPair Key
"authors" [Author]
bowerAuthors
      , Key -> Maybe Text -> [Pair]
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"homepage" Maybe Text
bowerHomepage
      , Key -> Maybe Repository -> [Pair]
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"repository" Maybe Repository
bowerRepository
      , Key -> [(PackageName, VersionRange)] -> [Pair]
forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc Key
"dependencies" [(PackageName, VersionRange)]
bowerDependencies
      , Key -> [(PackageName, VersionRange)] -> [Pair]
forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc Key
"devDependencies" [(PackageName, VersionRange)]
bowerDevDependencies
      , Key -> [(PackageName, Version)] -> [Pair]
forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc Key
"resolutions" [(PackageName, Version)]
bowerResolutions
      , if Bool
bowerPrivate then [ Key
"private" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True ] else []
      ]

      where
      assoc :: A.ToJSON a => A.Key -> [(PackageName, a)] -> [Aeson.Pair]
      assoc :: forall a. ToJSON a => Key -> [(PackageName, a)] -> [Pair]
assoc = (PackageName -> Key) -> Key -> [(PackageName, a)] -> [Pair]
forall b a. ToJSON b => (a -> Key) -> Key -> [(a, b)] -> [Pair]
maybeArrayAssocPair (Text -> Key
A.Key.fromText (Text -> Key) -> (PackageName -> Text) -> PackageName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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{Text
repositoryUrl :: Repository -> Text
repositoryType :: Repository -> Text
repositoryUrl :: Text
repositoryType :: Text
..} =
    [Pair] -> Value
A.object [ Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
repositoryUrl
             , Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
repositoryType
             ]

instance A.ToJSON Author where
  toJSON :: Author -> Value
toJSON Author{Maybe Text
Text
authorName :: Author -> Text
authorEmail :: Author -> Maybe Text
authorHomepage :: Author -> Maybe Text
authorName :: Text
authorEmail :: Maybe Text
authorHomepage :: Maybe Text
..} =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
authorName ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
        Key -> Maybe Text -> [Pair]
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"email" Maybe Text
authorEmail [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
        Key -> Maybe Text -> [Pair]
forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
"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 => A.Key -> Maybe a -> [Aeson.Pair]
maybePair :: forall a. ToJSON a => Key -> Maybe a -> [Pair]
maybePair Key
k = [Pair] -> (a -> [Pair]) -> Maybe a -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\a
val -> [Key
k Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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 Key -> [a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [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 Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
A.object (((a, b) -> Pair) -> [(a, b)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
k', b
v) -> a -> Key
f a
k' Key -> b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= b
v) [(a, b)]
xs)]

-------------------------

-- FromJSON instances


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)