bower-json 0.4.0.0 → 0.5.0.0
raw patch · 5 files changed
+392/−311 lines, 5 filesdep +aeson-better-errorsdep +mtldep +scientificPVP ok
version bump matches the API change (PVP)
Dependencies added: aeson-better-errors, mtl, scientific, transformers, vector
API changes (from Hackage documentation)
- Web.BowerJson: AMD :: ModuleType
- Web.BowerJson: Author :: String -> Maybe String -> Maybe String -> Author
- Web.BowerJson: BowerJson :: PackageName -> Maybe String -> [FilePath] -> [ModuleType] -> [String] -> [String] -> [String] -> [Author] -> Maybe String -> Maybe Repository -> [(PackageName, VersionRange)] -> [(PackageName, VersionRange)] -> [(PackageName, Version)] -> Bool -> BowerJson
- Web.BowerJson: ES6 :: ModuleType
- Web.BowerJson: Globals :: ModuleType
- Web.BowerJson: Node :: ModuleType
- Web.BowerJson: Repository :: String -> String -> Repository
- Web.BowerJson: Version :: String -> Version
- Web.BowerJson: VersionRange :: String -> VersionRange
- Web.BowerJson: YUI :: ModuleType
- Web.BowerJson: authorEmail :: Author -> Maybe String
- Web.BowerJson: authorHomepage :: Author -> Maybe String
- Web.BowerJson: authorName :: Author -> String
- Web.BowerJson: bowerAuthors :: BowerJson -> [Author]
- Web.BowerJson: bowerDependencies :: BowerJson -> [(PackageName, VersionRange)]
- Web.BowerJson: bowerDescription :: BowerJson -> Maybe String
- Web.BowerJson: bowerDevDependencies :: BowerJson -> [(PackageName, VersionRange)]
- Web.BowerJson: bowerHomepage :: BowerJson -> Maybe String
- Web.BowerJson: bowerIgnore :: BowerJson -> [String]
- Web.BowerJson: bowerKeywords :: BowerJson -> [String]
- Web.BowerJson: bowerLicence :: BowerJson -> [String]
- Web.BowerJson: bowerMain :: BowerJson -> [FilePath]
- Web.BowerJson: bowerModuleType :: BowerJson -> [ModuleType]
- Web.BowerJson: bowerName :: BowerJson -> PackageName
- Web.BowerJson: bowerPrivate :: BowerJson -> Bool
- Web.BowerJson: bowerRepository :: BowerJson -> Maybe Repository
- Web.BowerJson: bowerResolutions :: BowerJson -> [(PackageName, Version)]
- Web.BowerJson: data Author
- Web.BowerJson: data BowerJson
- Web.BowerJson: data ModuleType
- Web.BowerJson: data PackageName
- Web.BowerJson: data Repository
- Web.BowerJson: decodeFile :: FilePath -> IO (Either String BowerJson)
- Web.BowerJson: instance Enum ModuleType
- Web.BowerJson: instance Eq Author
- Web.BowerJson: instance Eq BowerJson
- Web.BowerJson: instance Eq ModuleType
- Web.BowerJson: instance Eq PackageName
- Web.BowerJson: instance Eq Repository
- Web.BowerJson: instance Eq Version
- Web.BowerJson: instance Eq VersionRange
- Web.BowerJson: instance FromJSON Author
- Web.BowerJson: instance FromJSON BowerJson
- Web.BowerJson: instance FromJSON ModuleType
- Web.BowerJson: instance FromJSON PackageName
- Web.BowerJson: instance FromJSON Repository
- Web.BowerJson: instance FromJSON Version
- Web.BowerJson: instance FromJSON VersionRange
- Web.BowerJson: instance Ord Author
- Web.BowerJson: instance Ord BowerJson
- Web.BowerJson: instance Ord ModuleType
- Web.BowerJson: instance Ord PackageName
- Web.BowerJson: instance Ord Repository
- Web.BowerJson: instance Ord Version
- Web.BowerJson: instance Ord VersionRange
- Web.BowerJson: instance Show Author
- Web.BowerJson: instance Show BowerJson
- Web.BowerJson: instance Show ModuleType
- Web.BowerJson: instance Show PackageName
- Web.BowerJson: instance Show Repository
- Web.BowerJson: instance Show Version
- Web.BowerJson: instance Show VersionRange
- Web.BowerJson: instance ToJSON Author
- Web.BowerJson: instance ToJSON BowerJson
- Web.BowerJson: instance ToJSON ModuleType
- Web.BowerJson: instance ToJSON PackageName
- Web.BowerJson: instance ToJSON Repository
- Web.BowerJson: instance ToJSON Version
- Web.BowerJson: instance ToJSON VersionRange
- Web.BowerJson: mkPackageName :: String -> Maybe PackageName
- Web.BowerJson: newtype Version
- Web.BowerJson: newtype VersionRange
- Web.BowerJson: repositoryType :: Repository -> String
- Web.BowerJson: repositoryUrl :: Repository -> String
- Web.BowerJson: runPackageName :: PackageName -> String
- Web.BowerJson: runVersion :: Version -> String
- Web.BowerJson: runVersionRange :: VersionRange -> String
+ Web.Bower.PackageMeta: AMD :: ModuleType
+ Web.Bower.PackageMeta: Author :: String -> Maybe String -> Maybe String -> Author
+ Web.Bower.PackageMeta: ES6 :: ModuleType
+ Web.Bower.PackageMeta: Globals :: ModuleType
+ Web.Bower.PackageMeta: InvalidChars :: String -> PackageNameError
+ Web.Bower.PackageMeta: InvalidModuleType :: String -> BowerError
+ Web.Bower.PackageMeta: InvalidPackageName :: PackageNameError -> BowerError
+ Web.Bower.PackageMeta: MustNotBeginSeparator :: PackageNameError
+ Web.Bower.PackageMeta: MustNotEndSeparator :: PackageNameError
+ Web.Bower.PackageMeta: Node :: ModuleType
+ Web.Bower.PackageMeta: NotEmpty :: PackageNameError
+ Web.Bower.PackageMeta: PackageMeta :: PackageName -> Maybe String -> [FilePath] -> [ModuleType] -> [String] -> [String] -> [String] -> [Author] -> Maybe String -> Maybe Repository -> [(PackageName, VersionRange)] -> [(PackageName, VersionRange)] -> [(PackageName, Version)] -> Bool -> PackageMeta
+ Web.Bower.PackageMeta: RepeatedSeparators :: PackageNameError
+ Web.Bower.PackageMeta: Repository :: String -> String -> Repository
+ Web.Bower.PackageMeta: TooLong :: Int -> PackageNameError
+ Web.Bower.PackageMeta: Version :: String -> Version
+ Web.Bower.PackageMeta: VersionRange :: String -> VersionRange
+ Web.Bower.PackageMeta: YUI :: ModuleType
+ Web.Bower.PackageMeta: asAuthor :: Parse e Author
+ Web.Bower.PackageMeta: asPackageMeta :: Parse BowerError PackageMeta
+ Web.Bower.PackageMeta: asRepository :: Parse e Repository
+ Web.Bower.PackageMeta: authorEmail :: Author -> Maybe String
+ Web.Bower.PackageMeta: authorHomepage :: Author -> Maybe String
+ Web.Bower.PackageMeta: authorName :: Author -> String
+ Web.Bower.PackageMeta: bowerAuthors :: PackageMeta -> [Author]
+ Web.Bower.PackageMeta: bowerDependencies :: PackageMeta -> [(PackageName, VersionRange)]
+ Web.Bower.PackageMeta: bowerDescription :: PackageMeta -> Maybe String
+ Web.Bower.PackageMeta: bowerDevDependencies :: PackageMeta -> [(PackageName, VersionRange)]
+ Web.Bower.PackageMeta: bowerHomepage :: PackageMeta -> Maybe String
+ Web.Bower.PackageMeta: bowerIgnore :: PackageMeta -> [String]
+ Web.Bower.PackageMeta: bowerKeywords :: PackageMeta -> [String]
+ Web.Bower.PackageMeta: bowerLicence :: PackageMeta -> [String]
+ Web.Bower.PackageMeta: bowerMain :: PackageMeta -> [FilePath]
+ Web.Bower.PackageMeta: bowerModuleType :: PackageMeta -> [ModuleType]
+ Web.Bower.PackageMeta: bowerName :: PackageMeta -> PackageName
+ Web.Bower.PackageMeta: bowerPrivate :: PackageMeta -> Bool
+ Web.Bower.PackageMeta: bowerRepository :: PackageMeta -> Maybe Repository
+ Web.Bower.PackageMeta: bowerResolutions :: PackageMeta -> [(PackageName, Version)]
+ Web.Bower.PackageMeta: data Author
+ Web.Bower.PackageMeta: data BowerError
+ Web.Bower.PackageMeta: data ModuleType
+ Web.Bower.PackageMeta: data PackageMeta
+ Web.Bower.PackageMeta: data PackageName
+ Web.Bower.PackageMeta: data PackageNameError
+ Web.Bower.PackageMeta: data Repository
+ Web.Bower.PackageMeta: decodeFile :: FilePath -> IO (Either (ParseError BowerError) PackageMeta)
+ Web.Bower.PackageMeta: mkPackageName :: String -> Either PackageNameError PackageName
+ Web.Bower.PackageMeta: moduleTypes :: [(String, ModuleType)]
+ Web.Bower.PackageMeta: newtype Version
+ Web.Bower.PackageMeta: newtype VersionRange
+ Web.Bower.PackageMeta: parseModuleType :: String -> Either BowerError ModuleType
+ Web.Bower.PackageMeta: parsePackageName :: String -> Either BowerError PackageName
+ Web.Bower.PackageMeta: repositoryType :: Repository -> String
+ Web.Bower.PackageMeta: repositoryUrl :: Repository -> String
+ Web.Bower.PackageMeta: runPackageName :: PackageName -> String
+ Web.Bower.PackageMeta: runVersion :: Version -> String
+ Web.Bower.PackageMeta: runVersionRange :: VersionRange -> String
+ Web.Bower.PackageMeta: showBowerError :: BowerError -> Text
+ Web.Bower.PackageMeta: showPackageNameError :: PackageNameError -> Text
Files
- bower-json.cabal +11/−5
- src/Web/Bower/PackageMeta.hs +34/−0
- src/Web/Bower/PackageMeta/Internal.hs +341/−0
- src/Web/BowerJson.hs +0/−299
- test/Main.hs +6/−7
bower-json.cabal view
@@ -1,6 +1,6 @@ name: bower-json-version: 0.4.0.0-synopsis: bower.json from Haskell+version: 0.5.0.0+synopsis: Read bower.json from Haskell license: MIT license-file: LICENSE author: Harry Garrood@@ -13,20 +13,26 @@ description: Bower is a package manager for the web (see <http://bower.io>). - This package provides a data type and FromJSON instance for Bower's package- manifest file, bower.json.+ This package provides a data type and ToJSON/FromJSON instances for Bower's+ package manifest file, bower.json. source-repository head type: git location: https://github.com/hdgarrood/bower-json library- exposed-modules: Web.BowerJson+ exposed-modules: Web.Bower.PackageMeta+ other-modules: Web.Bower.PackageMeta.Internal build-depends: base >=4 && <5 , aeson >=0.6.1.0+ , aeson-better-errors >= 0.4 , unordered-containers , text , bytestring+ , scientific+ , vector+ , transformers+ , mtl ghc-options: -Wall hs-source-dirs: src
+ src/Web/Bower/PackageMeta.hs view
@@ -0,0 +1,34 @@++-- | 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+ (+ -- * Data types+ PackageMeta(..)+ , PackageName+ , runPackageName+ , mkPackageName+ , Author(..)+ , ModuleType(..)+ , moduleTypes+ , Repository(..)+ , Version(..)+ , VersionRange(..)+ , BowerError(..)+ , showBowerError+ , PackageNameError(..)+ , showPackageNameError+ -- * Parsing+ , decodeFile+ , asPackageMeta+ , parseModuleType+ , parsePackageName+ , asAuthor+ , asRepository+ ) where++import Web.Bower.PackageMeta.Internal
+ src/Web/Bower/PackageMeta/Internal.hs view
@@ -0,0 +1,341 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-}++-- | 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.Applicative+import Control.Monad+import Control.Category ((>>>))+import Control.Monad.Error.Class (MonadError(..))+import Data.Monoid+import Data.List+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++---------------------+-- 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+ { bowerName :: PackageName+ , bowerDescription :: Maybe String+ , bowerMain :: [FilePath]+ , bowerModuleType :: [ModuleType]+ , bowerLicence :: [String]+ , bowerIgnore :: [String]+ , bowerKeywords :: [String]+ , bowerAuthors :: [Author]+ , bowerHomepage :: Maybe String+ , bowerRepository :: Maybe Repository+ , bowerDependencies :: [(PackageName, VersionRange)]+ , bowerDevDependencies :: [(PackageName, VersionRange)]+ , bowerResolutions :: [(PackageName, Version)]+ , bowerPrivate :: Bool+ }+ deriving (Show, Eq, Ord)++-- | A valid package name for a Bower package.+newtype PackageName+ = PackageName String+ deriving (Show, Eq, Ord)++runPackageName :: PackageName -> String+runPackageName (PackageName s) = 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 :: String -> Either PackageNameError PackageName+mkPackageName = fmap PackageName . validateAll validators+ where+ dashOrDot = ['-', '.']+ validateAll vs x = mapM_ (validateWith x) vs >> return x+ validateWith x (p, err)+ | p x = Right x+ | otherwise = Left (err x)+ validChar c = isAscii c && (isLower c || isDigit c || c `elem` dashOrDot)+ validators =+ [ (not . null, const NotEmpty)+ , (all validChar, InvalidChars . filter (not . validChar))+ , (headMay >>> isJustAnd (`notElem` dashOrDot), const MustNotBeginSeparator)+ , (lastMay >>> isJustAnd (`notElem` dashOrDot), const MustNotEndSeparator)+ , (not . isInfixOf "--", const RepeatedSeparators)+ , (not . isInfixOf "..", const RepeatedSeparators)+ , (length >>> (<= 50), TooLong . length)+ ]+ isJustAnd = maybe False++headMay :: [a] -> Maybe a+headMay [] = Nothing+headMay (x:_) = Just x++lastMay :: [a] -> Maybe a+lastMay [] = Nothing+lastMay [x] = Just x+lastMay (_:xs) = lastMay xs++data Author = Author+ { authorName :: String+ , authorEmail :: Maybe String+ , authorHomepage :: Maybe String+ }+ deriving (Show, Eq, Ord)++-- | See: <https://github.com/bower/bower.json-spec#moduletype>+data ModuleType+ = Globals+ | AMD+ | Node+ | ES6+ | YUI+ deriving (Show, Eq, Ord, Enum, Bounded)++moduleTypes :: [(String, ModuleType)]+moduleTypes = map (\t -> (map toLower (show t), t)) [minBound .. maxBound]++data Repository = Repository+ { repositoryUrl :: String+ , repositoryType :: String+ }+ deriving (Show, Eq, Ord)++newtype Version+ = Version { runVersion :: String }+ deriving (Show, Eq, Ord)++newtype VersionRange+ = VersionRange { runVersionRange :: String }+ deriving (Show, Eq, Ord)++data BowerError+ = InvalidPackageName PackageNameError+ | InvalidModuleType String++showBowerError :: BowerError -> Text+showBowerError (InvalidPackageName err) =+ "Invalid package name: " <> showPackageNameError err+showBowerError (InvalidModuleType str) =+ "Invalid module type: " <> T.pack str <>+ ". Must be one of: " <> renderList moduleTypes+ where+ renderList =+ map (T.pack . show . fst)+ >>> T.intercalate ", "++data PackageNameError+ = NotEmpty+ | TooLong Int+ | InvalidChars String+ | RepeatedSeparators+ | MustNotBeginSeparator+ | MustNotEndSeparator++showPackageNameError :: PackageNameError -> Text+showPackageNameError err = case err of+ NotEmpty ->+ "A package name may not be empty"+ TooLong x ->+ "Package names must be no more than 50 characters, yours was " <>+ T.pack (show x)+ InvalidChars str ->+ "The following characters are not permitted in package names: " <>+ T.intercalate " " (map T.singleton str)+ RepeatedSeparators ->+ "The substrings \"--\" and \"..\" may not appear in "<>+ "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"++-------------------------+-- Parsing++-- | Read and attempt to decode a bower.json file.+decodeFile :: FilePath -> IO (Either (ParseError BowerError) PackageMeta)+decodeFile = fmap (parse asPackageMeta) . B.readFile++-- | A parser for bower.json files, using the aeson-better-errors package.+asPackageMeta :: Parse BowerError PackageMeta+asPackageMeta =+ PackageMeta <$> key "name" (withString parsePackageName)+ <*> keyMay "description" asString+ <*> keyOrDefault "main" [] (eachInArray asString)+ <*> keyOrDefault "moduleType" [] (eachInArray (withString parseModuleType))+ <*> keyOrDefault "licence" [] (eachInArray asString)+ <*> keyOrDefault "ignore" [] (eachInArray asString)+ <*> keyOrDefault "keywords" [] (eachInArray asString)+ <*> keyOrDefault "authors" [] (eachInArray asAuthor)+ <*> keyMay "homepage" asString+ <*> keyMay "repository" asRepository+ <*> keyOrDefault "dependencies" [] (asAssocListOf VersionRange)+ <*> keyOrDefault "devDependencies" [] (asAssocListOf VersionRange)+ <*> keyOrDefault "resolutions" [] (asAssocListOf Version)+ <*> keyOrDefault "private" False asBool+ where+ asAssocListOf :: (String -> a) -> Parse BowerError [(PackageName, a)]+ asAssocListOf g =+ eachInObjectWithKey (parsePackageName . T.unpack) (g <$> asString)++parseModuleType :: String -> Either BowerError ModuleType+parseModuleType str =+ case lookup str moduleTypes of+ Nothing -> Left (InvalidModuleType str)+ Just mt -> Right mt++parsePackageName :: String -> Either BowerError PackageName+parsePackageName str =+ case mkPackageName str of+ Left err -> Left (InvalidPackageName err)+ Right n -> Right n++asAuthor :: Parse e Author+asAuthor = catchError asAuthorString (const asAuthorObject)++asAuthorString :: Parse e Author+asAuthorString = withString $ \s ->+ let (email, s1) = takeDelim "<" ">" (words s)+ (homepage, s2) = takeDelim "(" ")" s1+ in pure (Author (unwords s2) email 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 :: String -> String -> [String] -> (Maybe String, [String])+takeDelim start end = foldr go (Nothing, [])+ where+ go str (Just x, strs) =+ (Just x, str : strs)+ go str (Nothing, strs) =+ case stripWrapper start end str of+ Just str' -> (Just str', strs)+ Nothing -> (Nothing, str : strs)++-- | Like stripPrefix, but strips a suffix as well.+stripWrapper :: String -> String -> String -> Maybe String+stripWrapper start end =+ stripPrefix start+ >>> fmap reverse+ >=> stripPrefix (reverse end)+ >>> fmap reverse++asAuthorObject :: Parse e Author+asAuthorObject =+ Author <$> key "name" asString+ <*> keyMay "email" asString+ <*> keyMay "homepage" asString++asRepository :: Parse e Repository+asRepository =+ Repository <$> key "url" asString+ <*> key "type" asString++------------------------+-- Serializing++instance A.ToJSON PackageMeta where+ toJSON PackageMeta{..} =+ A.object $ concat+ [ [ "name" .= bowerName ]+ , maybePair "description" bowerDescription+ , maybeArrayPair "main" bowerMain+ , maybeArrayPair "moduleType" bowerModuleType+ , maybeArrayPair "licence" bowerLicence+ , maybeArrayPair "ignore" bowerIgnore+ , maybeArrayPair "keywords" bowerKeywords+ , maybeArrayPair "authors" bowerAuthors+ , maybePair "homepage" bowerHomepage+ , maybePair "repository" bowerRepository+ , assoc "dependencies" bowerDependencies+ , assoc "devDependencies" bowerDevDependencies+ , assoc "resolutions" bowerResolutions+ , if bowerPrivate then [ "private" .= True ] else []+ ]++ where+ toText = T.pack . runPackageName++ assoc :: A.ToJSON a => Text -> [(PackageName, a)] -> [Aeson.Pair]+ assoc = maybeArrayAssocPair toText++instance A.ToJSON PackageName where+ toJSON = A.toJSON . runPackageName++instance A.ToJSON ModuleType where+ toJSON = A.toJSON . map toLower . show++instance A.ToJSON Repository where+ toJSON Repository{..} =+ A.object [ "url" .= repositoryUrl+ , "type" .= repositoryType+ ]++instance A.ToJSON Author where+ toJSON Author{..} =+ A.object $+ [ "name" .= authorName ] +++ maybePair "email" authorEmail +++ maybePair "homepage" authorHomepage++instance A.ToJSON Version where+ toJSON = A.toJSON . runVersion++instance A.ToJSON VersionRange where+ toJSON = A.toJSON . runVersionRange++maybePair :: A.ToJSON a => Text -> Maybe a -> [Aeson.Pair]+maybePair k = maybe [] (\val -> [k .= val])++maybeArrayPair :: A.ToJSON a => Text -> [a] -> [Aeson.Pair]+maybeArrayPair _ [] = []+maybeArrayPair k xs = [k .= xs]++maybeArrayAssocPair :: A.ToJSON b => (a -> Text) -> Text -> [(a,b)] -> [Aeson.Pair]+maybeArrayAssocPair _ _ [] = []+maybeArrayAssocPair f k xs = [k .= A.object (map (\(k', v) -> f k' .= v) xs)]++-------------------------+-- FromJSON instances++instance A.FromJSON PackageMeta where+ parseJSON = toAesonParser showBowerError asPackageMeta++instance A.FromJSON PackageName where+ parseJSON = toAesonParser showBowerError (withString parsePackageName)++instance A.FromJSON ModuleType where+ parseJSON = toAesonParser showBowerError (withString parseModuleType)++instance A.FromJSON Repository where+ parseJSON = toAesonParser' asRepository++instance A.FromJSON Author where+ parseJSON = toAesonParser' asAuthor++instance A.FromJSON Version where+ parseJSON = toAesonParser' (Version <$> asString)++instance A.FromJSON VersionRange where+ parseJSON = toAesonParser' (VersionRange <$> asString)
− src/Web/BowerJson.hs
@@ -1,299 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE RecordWildCards #-}---- | 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.BowerJson- ( BowerJson(..)- , decodeFile- , PackageName- , runPackageName- , mkPackageName- , ModuleType(..)- , Author(..)- , Repository(..)- , VersionRange(..)- , Version(..)- ) where--import Control.Applicative-import Control.Monad-import Control.Category ((>>>))-import Data.List-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.Types as Aeson-import qualified Data.HashMap.Strict as HashMap---- | 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 BowerJson value, encode to JSON, and then decode, you--- should always get the same value back.-data BowerJson = BowerJson- { bowerName :: PackageName- , bowerDescription :: Maybe String- , bowerMain :: [FilePath]- , bowerModuleType :: [ModuleType]- , bowerLicence :: [String]- , bowerIgnore :: [String]- , bowerKeywords :: [String]- , bowerAuthors :: [Author]- , bowerHomepage :: Maybe String- , bowerRepository :: Maybe Repository- , bowerDependencies :: [(PackageName, VersionRange)]- , bowerDevDependencies :: [(PackageName, VersionRange)]- , bowerResolutions :: [(PackageName, Version)]- , bowerPrivate :: Bool- }- deriving (Show, Eq, Ord)--instance FromJSON BowerJson where- parseJSON =- withObject "BowerJson" $ \o ->- BowerJson <$> (o .: "name" >>= parsePackageName)- <*> o .:? "description"- <*> o .:? "main" .!= []- <*> o .:? "moduleType" .!= []- <*> o .:? "licence" .!= []- <*> o .:? "ignore" .!= []- <*> o .:? "keywords" .!= []- <*> o .:? "authors" .!= []- <*> o .:? "homepage"- <*> o .:? "repository"- <*> parseAssocList o "dependencies"- <*> parseAssocList o "devDependencies"- <*> parseAssocList o "resolutions"- <*> o .:? "private" .!= False- where- liftMaybe :: String -> (a -> Maybe b) -> a -> Aeson.Parser b- liftMaybe ty f =- maybe (fail ("unable to parse a value of type: " ++ ty)) return . f-- parsePackageName :: String -> Aeson.Parser PackageName- parsePackageName = liftMaybe "PackageName" mkPackageName-- parseAssocList :: FromJSON v =>- Aeson.Object -> Text -> Aeson.Parser [(PackageName, v)]- parseAssocList o k = - o .:? k .!= HashMap.empty- >>= assocListFromObject (parsePackageName . T.unpack)--assocListFromObject :: FromJSON v =>- (Text -> Aeson.Parser a) ->- Aeson.Object ->- Aeson.Parser [(a,v)]-assocListFromObject parseKey o = do- let xs = HashMap.toList o- mapM (\(k, v) -> (,) <$> parseKey k <*> parseJSON v) xs--instance ToJSON BowerJson where- toJSON BowerJson{..} =- object $ concat- [ [ "name" .= bowerName ]- , maybePair "description" bowerDescription- , maybeArrayPair "main" bowerMain- , maybeArrayPair "moduleType" bowerModuleType- , maybeArrayPair "licence" bowerLicence- , maybeArrayPair "ignore" bowerIgnore- , maybeArrayPair "keywords" bowerKeywords- , maybeArrayPair "authors" bowerAuthors- , maybePair "homepage" bowerHomepage- , maybePair "repository" bowerRepository- , assoc "dependencies" bowerDependencies- , assoc "devDependencies" bowerDevDependencies- , assoc "resolutions" bowerResolutions- , if bowerPrivate then [ "private" .= True ] else []- ]-- where- asText = T.pack . runPackageName-- assoc :: ToJSON a => Text -> [(PackageName, a)] -> [Aeson.Pair]- assoc = maybeArrayAssocPair asText--maybePair :: ToJSON a => Text -> Maybe a -> [Aeson.Pair]-maybePair key = maybe [] (\val -> [key .= val])--maybeArrayPair :: ToJSON a => Text -> [a] -> [Aeson.Pair]-maybeArrayPair _ [] = []-maybeArrayPair key xs = [key .= xs]--maybeArrayAssocPair :: ToJSON b => (a -> Text) -> Text -> [(a,b)] -> [Aeson.Pair]-maybeArrayAssocPair _ _ [] = []-maybeArrayAssocPair f key xs = [key .= object (map (\(k, v) -> f k .= v) xs)]---- | Read and attempt to decode a bower.json file.-decodeFile :: FilePath -> IO (Either String BowerJson)-decodeFile = fmap eitherDecode . B.readFile---- | A valid package name for a Bower package.-newtype PackageName- = PackageName String- deriving (Show, Eq, Ord)--runPackageName :: PackageName -> String-runPackageName (PackageName s) = s--instance FromJSON PackageName where- parseJSON =- withText "PackageName" $ \text ->- case mkPackageName (T.unpack text) of- Just pkgName -> return pkgName- Nothing -> fail ("unable to validate package name: " ++ show text)--instance ToJSON PackageName where- toJSON = toJSON . runPackageName---- | 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 :: String -> Maybe PackageName-mkPackageName str- | satisfyAll predicates str = Just (PackageName str)- | otherwise = Nothing- where- dashOrDot = ['-', '.']- satisfyAll ps x = all ($ x) ps- predicates =- [ not . null- , all isAscii -- note: this is necessary because isLower allows Unicode.- , all (\c -> isLower c || isDigit c || c `elem` dashOrDot)- , headMay >>> isJustAnd (`notElem` dashOrDot)- , lastMay >>> isJustAnd (`notElem` dashOrDot)- , not . isInfixOf "--"- , not . isInfixOf ".."- , length >>> (<= 50)- ]- isJustAnd = maybe False--headMay :: [a] -> Maybe a-headMay [] = Nothing-headMay (x:_) = Just x--lastMay :: [a] -> Maybe a-lastMay [] = Nothing-lastMay [x] = Just x-lastMay (_:xs) = lastMay xs---- | See: <https://github.com/bower/bower.json-spec#moduletype>-data ModuleType- = Globals- | AMD- | Node- | ES6- | YUI- deriving (Show, Eq, Ord, Enum)--moduleTypes :: [(String, ModuleType)]-moduleTypes = map (\t -> (map toLower (show t), t)) [Globals .. YUI]--instance FromJSON ModuleType where- parseJSON =- withText "ModuleType" $ \t ->- case lookup (T.unpack t) moduleTypes of- Just t' -> return t'- Nothing -> fail ("invalid module type: " ++ show t)--instance ToJSON ModuleType where- toJSON = toJSON . map toLower . show--data Repository = Repository- { repositoryUrl :: String- , repositoryType :: String- }- deriving (Show, Eq, Ord)--instance FromJSON Repository where- parseJSON =- withObject "Repository" $ \o ->- Repository <$> o .: "url"- <*> o .: "type"--instance ToJSON Repository where- toJSON Repository{..} =- object [ "url" .= repositoryUrl- , "type" .= repositoryType- ]--data Author = Author- { authorName :: String- , authorEmail :: Maybe String- , authorHomepage :: Maybe String- }- deriving (Show, Eq, Ord)--instance FromJSON Author where- parseJSON (Object o) =- Author <$> o .: "name"- <*> o .:? "email"- <*> o .:? "homepage"- parseJSON (String t) =- pure (Author (unwords s2) email homepage)- where- (email, s1) = takeDelim "<" ">" (words (T.unpack t))- (homepage, s2) = takeDelim "(" ")" s1- parseJSON v =- Aeson.typeMismatch "Author" v--instance ToJSON Author where- toJSON Author{..} =- object $- [ "name" .= authorName ] ++- maybePair "email" authorEmail ++- maybePair "homepage" authorHomepage---- | 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 :: String -> String -> [String] -> (Maybe String, [String])-takeDelim start end = foldr go (Nothing, [])- where- go str (Just x, strs) =- (Just x, str : strs)- go str (Nothing, strs) =- case stripWrapper start end str of- Just str' -> (Just str', strs)- Nothing -> (Nothing, str : strs)---- | Like stripPrefix, but strips a suffix as well.-stripWrapper :: String -> String -> String -> Maybe String-stripWrapper start end =- stripPrefix start- >>> fmap reverse- >=> stripPrefix (reverse end)- >>> fmap reverse--newtype Version- = Version { runVersion :: String }- deriving (Show, Eq, Ord)--instance FromJSON Version where- parseJSON =- withText "Version" (pure . Version . T.unpack)--instance ToJSON Version where- toJSON = toJSON . runVersion--newtype VersionRange- = VersionRange { runVersionRange :: String }- deriving (Show, Eq, Ord)--instance FromJSON VersionRange where- parseJSON =- withText "VersionRange" (pure . VersionRange . T.unpack)--instance ToJSON VersionRange where- toJSON = toJSON . runVersionRange
test/Main.hs view
@@ -6,10 +6,9 @@ import Control.Monad import Data.Monoid import Data.Aeson-import Data.Maybe import qualified Data.ByteString.Lazy as B -import Web.BowerJson+import Web.Bower.PackageMeta -- Decode any JSON value, not just arrays/objects. -- this is a bit of a hack, but the 'proper' way is just too much effort.@@ -89,9 +88,9 @@ ] where -pkgName = fromJust (mkPackageName "test-package")-depPkgName = fromJust (mkPackageName "dependency-package")-basic = BowerJson pkgName Nothing [] [] [] [] [] [] Nothing Nothing [] [] [] False+Right pkgName = mkPackageName "test-package"+Right depPkgName = mkPackageName "dependency-package"+basic = PackageMeta pkgName Nothing [] [] [] [] [] [] Nothing Nothing [] [] [] False basicWithDeps = basic { bowerDependencies = [(depPkgName, VersionRange ">= 1.0")] } basicWithModuleType = basic { bowerModuleType = [AMD] } @@ -112,7 +111,7 @@ complexPrivate = complex { bowerPrivate = True } -allBowerJsons =+allPkgs = [ ("basic", basic) , ("basicWithDeps", basicWithDeps) , ("basicWithModuleType", basicWithModuleType)@@ -123,4 +122,4 @@ roundTripTests :: [TestTree] roundTripTests = map (\(name, b) -> testCase name (Just b @=? decode (encode b)))- allBowerJsons+ allPkgs