packages feed

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 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