bower-json (empty) → 0.1.0.0
raw patch · 6 files changed
+399/−0 lines, 6 filesdep +aesondep +basedep +bower-jsonsetup-changed
Dependencies added: aeson, base, bower-json, bytestring, containers, filepath, tasty, tasty-hunit, text, unordered-containers
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- bower-json.cabal +48/−0
- src/Web/BowerJson.hs +169/−0
- src/Web/BowerJson/Utils.hs +64/−0
- test/Main.hs +96/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Harry Garrood++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bower-json.cabal view
@@ -0,0 +1,48 @@+name: bower-json+version: 0.1.0.0+synopsis: bower.json from Haskell+license: MIT+license-file: LICENSE+author: Harry Garrood+maintainer: harry@garrood.me+homepage: https://github.com/hdgarrood/bower-json+category: Web+build-type: Simple+cabal-version: >=1.10++description:+ This package provides a data type and FromJSON instance for bower.json+ package description files.++source-repository head+ type: git+ location: https://github.com/hdgarrood/bower-json++library+ exposed-modules: Web.BowerJson+ other-modules: Web.BowerJson.Utils+ build-depends: base >=4 && <5+ , aeson >=0.6+ , filepath+ , containers+ , unordered-containers+ , text+ , bytestring++ ghc-options: -Wall+ hs-source-dirs: src+ default-language: Haskell2010++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ build-depends: base >=4 && <5+ , bower-json -any+ , aeson -any+ , bytestring -any+ , containers -any+ , tasty -any+ , tasty-hunit -any+ ghc-options: -Wall+ default-language: Haskell2010
+ src/Web/BowerJson.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TupleSections #-}++-- | 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 where++import Control.Applicative+import Control.Category ((>>>))+import Data.Char+import Data.Map (Map)+import qualified Data.Text as T+import qualified Data.HashMap.Strict as HashMap+import Data.Aeson+import qualified Data.Aeson.Types as Aeson++import Web.BowerJson.Utils++-- | A data type representing the data stored in a bower.json package manifest+-- file.+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 :: Map PackageName VersionRange+ , bowerDevDependencies :: Map PackageName VersionRange+ , bowerResolutions :: Map PackageName Version+ , isPrivate :: 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"+ <*> o `mapWithArbitraryKeys` "dependencies"+ <*> o `mapWithArbitraryKeys` "devDependencies"+ <*> o `mapWithArbitraryKeys` "resolutions"+ <*> o .:? "private" .!= False+ where+ liftMaybe :: String -> (a -> Maybe b) -> a -> Aeson.Parser b+ liftMaybe msg f =+ maybe (fail ("unable to parse a value of type: " ++ msg)) return . f++ parsePackageName :: String -> Aeson.Parser PackageName+ parsePackageName = liftMaybe "PackageName" mkPackageName++ mapWithArbitraryKeys o' field =+ (o' .:? field .!= Object HashMap.empty)+ >>= parseWithArbitraryKeys parsePackageName++------------------+-- Package names++-- | A valid package name for a Bower package.+newtype PackageName+ = PackageName { runPackageName :: String }+ deriving (Show, Eq, Ord)++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)++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)+ ]+ isJustAnd = maybe False++-- | 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)++data Repository = Repository+ { repositoryUrl :: String+ , repositoryType :: String+ }+ deriving (Show, Eq, Ord)++instance FromJSON Repository where+ parseJSON =+ withObject "Repository" $ \o ->+ Repository <$> o .: "url"+ <*> o .: "type"++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++newtype Version+ = Version { runVersion :: String }+ deriving (Show, Eq, Ord)++instance FromJSON Version where+ parseJSON =+ withText "Version" (pure . Version . T.unpack)++newtype VersionRange+ = VersionRange { runVersionRange :: String }+ deriving (Show, Eq, Ord)++instance FromJSON VersionRange where+ parseJSON =+ withText "VersionRange" (pure . VersionRange . T.unpack)
+ src/Web/BowerJson/Utils.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TupleSections #-}++module Web.BowerJson.Utils where++import Control.Applicative+import Control.Monad+import Control.Category ((>>>))+import Data.List (stripPrefix)+import Data.Map (Map)+import qualified Data.Map as M+import Data.Traversable (traverse)+import Data.Aeson+import qualified Data.Aeson.Types as Aeson++--------------+-- Safe++headMay :: [a] -> Maybe a+headMay [] = Nothing+headMay (x:_) = Just x++lastMay :: [a] -> Maybe a+lastMay [] = Nothing+lastMay [x] = Just x+lastMay (_:xs) = lastMay xs++----------------+-- Aeson++-- | Aeson only provides FromJSON instances such as: @FromJSON a => FromJSON+-- (Map String a)@. This function allows you to parse a Map value from JSON+-- where the keys are not 'String', when you supply a function @(String ->+-- Parser a)@ to parse the keys with.+parseWithArbitraryKeys :: (Ord a, FromJSON v) =>+ (String -> Aeson.Parser a) -> Value -> Aeson.Parser (Map a v)+parseWithArbitraryKeys parseKey v' = do+ list <- M.toList <$> parseJSON v'+ list' <- traverse (\(k, v) -> (,v) <$> parseKey k) list+ return (M.fromList list')++-------------------------+-- String manipulation++-- | 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
+ test/Main.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad+import Data.Monoid+import Data.Aeson+import Data.Maybe+import qualified Data.Map as M+import qualified Data.ByteString.Lazy as B++import Web.BowerJson++-- Decode any JSON value, not just arrays/objects.+-- this is a bit of a hack, but the 'proper' way is just too much effort.+decodeValue :: FromJSON a => B.ByteString -> Maybe a+decodeValue = the <=< decode . ("[" <>) . (<> "]")+ where+ the [x] = Just x+ the _ = Nothing++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tests"+ [ testGroup "FromJSON Author instance" authorTests+ , testGroup "optional keys" optionalKeyTests+ ]++authorTests :: [TestTree]+authorTests =+ [ testCase "As string without homepage/email" $ do+ authorWithoutOptionalAttrs @=?+ decodeValue "\"Harry Garrood\""++ -- should not be sensitive to extra whitespace+ authorWithoutOptionalAttrs @=?+ decodeValue "\" Harry Garrood \""++ , testCase "As string with homepage/email" $ do+ authorWithEmail @=?+ decodeValue "\"Harry Garrood <harry@garrood.me>\""++ authorWithHomepage @=?+ decodeValue "\"Harry Garrood (http://harry.garrood.me)\""++ authorWithBoth @=?+ decodeValue "\"Harry Garrood <harry@garrood.me> (http://harry.garrood.me)\""++ , testCase "As object" $ do+ authorWithoutOptionalAttrs @=?+ decode "{\"name\": \"Harry Garrood\"}"++ authorWithEmail @=?+ decode "{\"name\": \"Harry Garrood\", \"email\": \"harry@garrood.me\"}"++ authorWithHomepage @=?+ decode "{\"name\": \"Harry Garrood\", \"homepage\": \"http://harry.garrood.me\"}"++ authorWithBoth @=?+ decode "{\"name\": \"Harry Garrood\", \"email\": \"harry@garrood.me\", \"homepage\": \"http://harry.garrood.me\"}"+ ]++ where+ authorWithoutOptionalAttrs = Just (Author "Harry Garrood" Nothing Nothing)+ authorWithEmail = Just (Author "Harry Garrood" (Just "harry@garrood.me") Nothing)+ authorWithHomepage = Just (Author "Harry Garrood" Nothing (Just "http://harry.garrood.me"))+ authorWithBoth = Just (Author "Harry Garrood" (Just "harry@garrood.me") (Just "http://harry.garrood.me"))++optionalKeyTests :: [TestTree]+optionalKeyTests =+ [ testCase "Missing keys should become empty maps/lists, missing private key means not private" $ do+ Just basic @=? decode "{\"name\": \"test-package\"}"++ , testCase "Empty maps should remain as empty maps" $ do+ Just basic @=? decode "{\"name\": \"test-package\", \"dependencies\": {}}"++ , testCase "Maps with values should be parsed" $ do+ Just basicWithDeps @=?+ decode "{\"name\": \"test-package\", \"dependencies\": {\"dependency-package\": \">= 1.0\"}}"++ , testCase "Empty arrays should be parsed as empty lists" $ do+ Just basic @=? decode "{\"name\": \"test-package\", \"main\": []}"++ , testCase "Arrays with values should be parsed" $ do+ Just basicWithModuleType @=?+ decode "{\"name\": \"test-package\", \"moduleType\": [\"amd\"]}"+ ]+ where+ pkgName = fromJust (mkPackageName "test-package")+ depPkgName = fromJust (mkPackageName "dependency-package")+ basic = BowerJson pkgName Nothing [] [] [] [] [] [] Nothing Nothing M.empty M.empty M.empty False+ basicWithDeps = basic { bowerDependencies = M.fromList [(depPkgName, VersionRange ">= 1.0")] }+ basicWithModuleType = basic { bowerModuleType = [AMD] }