stackage-types (empty) → 1.0.0
raw patch · 5 files changed
+436/−0 lines, 5 filesdep +Cabaldep +aesondep +basesetup-changed
Dependencies added: Cabal, aeson, base, containers, exceptions, hashable, semigroups, text, unordered-containers, vector
Files
- LICENSE +20/−0
- README.md +10/−0
- Setup.hs +2/−0
- Stackage/Types.hs +377/−0
- stackage-types.cabal +27/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Michael Snoyman++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.
+ README.md view
@@ -0,0 +1,10 @@+## stackage-types++This is a repository for sharing data types across multiple packages in the+[Stackage project](https://www.stackage.org). In particular, it started as a+means of sharing code between+[stackage-curator](https://github.com/fpco/stackage-curator) and+[stackage-server](https://github.com/fpco/stackage-server).++For more information on the overall Stackage project, please see [the main+stackage repo](https://github.com/fpco/stackage).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Stackage/Types.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+-- | Shared types for various stackage packages.+module Stackage.Types+ ( -- * Types+ SnapshotType (..)+ , DocMap+ , PackageDocs (..)+ , BuildPlan (..)+ , PackagePlan (..)+ , PackageConstraints (..)+ , ParseFailedException (..)+ , TestState (..)+ , SystemInfo (..)+ , Maintainer (..)+ , ExeName (..)+ , SimpleDesc (..)+ , DepInfo (..)+ , Component (..)+ -- * Helper functions+ , display+ , simpleParse+ , unPackageName+ , mkPackageName+ , unFlagName+ , mkFlagName+ , intersectVersionRanges+ ) where++import Control.Applicative ((<$>), (<*>))+import Control.Arrow ((&&&))+import Control.Exception (Exception)+import Control.Monad.Catch (MonadThrow, throwM)+import Data.Aeson (FromJSON (..), ToJSON (..),+ object, withObject, withText,+ (.!=), (.:), (.:?), (.=))+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HashMap+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid, mappend, mempty)+import Data.Semigroup (Semigroup, (<>))+import Data.Set (Set)+import qualified Data.Set as Set+import Data.String (IsString, fromString)+import Data.Text (Text, pack, unpack)+import qualified Data.Text as T+import qualified Data.Traversable as T+import Data.Typeable (TypeRep, Typeable, typeOf)+import Data.Vector (Vector)+import Distribution.Package (PackageName (PackageName))+import Distribution.PackageDescription (FlagName (..))+import Distribution.System (Arch, OS)+import qualified Distribution.Text as DT+import Distribution.Version (Version, VersionRange)+import qualified Distribution.Version as C++data SnapshotType = STNightly+ | STLTS !Int !Int -- ^ major, minor+ deriving (Show, Read, Eq, Ord)++instance ToJSON SnapshotType where+ toJSON STNightly = object+ [ "type" .= asText "nightly"+ ]+ toJSON (STLTS major minor) = object+ [ "type" .= asText "lts"+ , "major" .= major+ , "minor" .= minor+ ]+instance FromJSON SnapshotType where+ parseJSON = withObject "SnapshotType" $ \o -> do+ t <- o .: "type"+ case asText t of+ "nightly" -> return STNightly+ "lts" -> STLTS+ <$> o .: "major"+ <*> o .: "minor"+ _ -> fail $ "Unknown type for SnapshotType: " ++ unpack t++-- | Package name is key+type DocMap = Map Text PackageDocs++asText :: Text -> Text+asText = id++data PackageDocs = PackageDocs+ { pdVersion :: Text+ , pdModules :: Map Text [Text]+ -- ^ module name, path+ }+instance ToJSON PackageDocs where+ toJSON PackageDocs {..} = object+ [ "version" .= pdVersion+ , "modules" .= pdModules+ ]+instance FromJSON PackageDocs where+ parseJSON = withObject "PackageDocs" $ \o -> PackageDocs+ <$> o .: "version"+ <*> o .: "modules"++data BuildPlan = BuildPlan+ { bpSystemInfo :: SystemInfo+ , bpTools :: Vector (PackageName, Version)+ , bpPackages :: Map PackageName PackagePlan+ , bpGithubUsers :: Map Text (Set Text)+ }+ deriving (Show, Eq)++instance ToJSON BuildPlan where+ toJSON BuildPlan {..} = object+ [ "system-info" .= bpSystemInfo+ , "tools" .= fmap goTool bpTools+ , "packages" .= Map.mapKeysWith const unPackageName bpPackages+ , "github-users" .= bpGithubUsers+ ]+ where+ goTool (k, v) = object+ [ "name" .= display k+ , "version" .= display v+ ]+instance FromJSON BuildPlan where+ parseJSON = withObject "BuildPlan" $ \o -> do+ bpSystemInfo <- o .: "system-info"+ bpTools <- (o .: "tools") >>= T.mapM goTool+ bpPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")+ bpGithubUsers <- o .:? "github-users" .!= mempty+ return BuildPlan {..}+ where+ goTool = withObject "Tool" $ \o -> (,)+ <$> ((o .: "name") >>=+ either (fail . show) return . simpleParse . asText)+ <*> ((o .: "version") >>=+ either (fail . show) return . simpleParse . asText)++data PackagePlan = PackagePlan+ { ppVersion :: Version+ , ppGithubPings :: Set Text+ , ppUsers :: Set PackageName+ , ppConstraints :: PackageConstraints+ , ppDesc :: SimpleDesc+ }+ deriving (Show, Eq)++instance ToJSON PackagePlan where+ toJSON PackagePlan {..} = object+ [ "version" .= asText (display ppVersion)+ , "github-pings" .= ppGithubPings+ , "users" .= Set.map unPackageName ppUsers+ , "constraints" .= ppConstraints+ , "description" .= ppDesc+ ]+instance FromJSON PackagePlan where+ parseJSON = withObject "PackageBuild" $ \o -> do+ ppVersion <- o .: "version"+ >>= either (fail . show) return+ . simpleParse . asText+ ppGithubPings <- o .:? "github-pings" .!= mempty+ ppUsers <- Set.map PackageName <$> (o .:? "users" .!= mempty)+ ppConstraints <- o .: "constraints"+ ppDesc <- o .: "description"+ return PackagePlan {..}++display :: DT.Text a => a -> Text+display = fromString . DT.display++simpleParse :: (MonadThrow m, DT.Text a, Typeable a) => Text -> m a+simpleParse orig = withTypeRep $ \rep ->+ case DT.simpleParse str of+ Nothing -> throwM (ParseFailedException rep (pack str))+ Just v -> return v+ where+ str = unpack orig++ withTypeRep :: Typeable a => (TypeRep -> m a) -> m a+ withTypeRep f =+ res+ where+ res = f (typeOf (unwrap res))++ unwrap :: m a -> a+ unwrap _ = error "unwrap"++data ParseFailedException = ParseFailedException TypeRep Text+ deriving (Show, Typeable)+instance Exception ParseFailedException++unPackageName :: PackageName -> Text+unPackageName (PackageName str) = pack str++mkPackageName :: Text -> PackageName+mkPackageName = PackageName . unpack++data PackageConstraints = PackageConstraints+ { pcVersionRange :: VersionRange+ , pcMaintainer :: Maybe Maintainer+ , pcTests :: TestState+ , pcHaddocks :: TestState+ , pcBuildBenchmarks :: Bool+ , pcFlagOverrides :: Map FlagName Bool+ , pcEnableLibProfile :: Bool+ }+ deriving (Show, Eq)+instance ToJSON PackageConstraints where+ toJSON PackageConstraints {..} = object $ addMaintainer+ [ "version-range" .= display pcVersionRange+ , "tests" .= pcTests+ , "haddocks" .= pcHaddocks+ , "build-benchmarks" .= pcBuildBenchmarks+ , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides+ , "library-profiling" .= pcEnableLibProfile+ ]+ where+ addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer+instance FromJSON PackageConstraints where+ parseJSON = withObject "PackageConstraints" $ \o -> do+ pcVersionRange <- (o .: "version-range")+ >>= either (fail . show) return . simpleParse+ pcTests <- o .: "tests"+ pcHaddocks <- o .: "haddocks"+ pcBuildBenchmarks <- o .: "build-benchmarks"+ pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"+ pcMaintainer <- o .:? "maintainer"+ pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")+ return PackageConstraints {..}++data TestState = ExpectSuccess+ | ExpectFailure+ | Don'tBuild -- ^ when the test suite will pull in things we don't want+ deriving (Show, Eq, Ord, Bounded, Enum)++testStateToText :: TestState -> Text+testStateToText ExpectSuccess = "expect-success"+testStateToText ExpectFailure = "expect-failure"+testStateToText Don'tBuild = "do-not-build"++instance ToJSON TestState where+ toJSON = toJSON . testStateToText+instance FromJSON TestState where+ parseJSON = withText "TestState" $ \t ->+ case HashMap.lookup t states of+ Nothing -> fail $ "Invalid state: " ++ unpack t+ Just v -> return v+ where+ states = HashMap.fromList+ $ map (\x -> (testStateToText x, x)) [minBound..maxBound]++data SystemInfo = SystemInfo+ { siGhcVersion :: Version+ , siOS :: OS+ , siArch :: Arch+ , siCorePackages :: Map PackageName Version+ , siCoreExecutables :: Set ExeName+ }+ deriving (Show, Eq, Ord)+instance ToJSON SystemInfo where+ toJSON SystemInfo {..} = object+ [ "ghc-version" .= display siGhcVersion+ , "os" .= display siOS+ , "arch" .= display siArch+ , "core-packages" .= Map.mapKeysWith const unPackageName (fmap display siCorePackages)+ , "core-executables" .= siCoreExecutables+ ]+instance FromJSON SystemInfo where+ parseJSON = withObject "SystemInfo" $ \o -> do+ let helper name = (o .: name) >>= either (fail . show) return . simpleParse+ siGhcVersion <- helper "ghc-version"+ siOS <- helper "os"+ siArch <- helper "arch"+ siCorePackages <- (o .: "core-packages") >>= goPackages+ siCoreExecutables <- o .: "core-executables"+ return SystemInfo {..}+ where+ goPackages = either (fail . show) return+ . T.mapM simpleParse+ . Map.mapKeysWith const mkPackageName++unFlagName :: FlagName -> Text+unFlagName (FlagName str) = pack str++mkFlagName :: Text -> FlagName+mkFlagName = FlagName . unpack++newtype Maintainer = Maintainer { unMaintainer :: Text }+ deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)++-- | Name of an executable.+newtype ExeName = ExeName { unExeName :: Text }+ deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)++-- | A simplified package description that tracks:+--+-- * Package dependencies+--+-- * Build tool dependencies+--+-- * Provided executables+--+-- It has fully resolved all conditionals+data SimpleDesc = SimpleDesc+ { sdPackages :: Map PackageName DepInfo+ , sdTools :: Map ExeName DepInfo+ , sdProvidedExes :: Set ExeName+ , sdModules :: Set Text+ -- ^ modules exported by the library+ }+ deriving (Show, Eq)+instance Monoid SimpleDesc where+ mempty = SimpleDesc mempty mempty mempty mempty+ mappend (SimpleDesc a b c d) (SimpleDesc w x y z) = SimpleDesc+ (Map.unionWith (<>) a w)+ (Map.unionWith (<>) b x)+ (c <> y)+ (d <> z)+instance ToJSON SimpleDesc where+ toJSON SimpleDesc {..} = object+ [ "packages" .= Map.mapKeysWith const unPackageName sdPackages+ , "tools" .= Map.mapKeysWith const unExeName sdTools+ , "provided-exes" .= sdProvidedExes+ , "modules" .= sdModules+ ]+instance FromJSON SimpleDesc where+ parseJSON = withObject "SimpleDesc" $ \o -> do+ sdPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")+ sdTools <- Map.mapKeysWith const ExeName <$> (o .: "tools")+ sdProvidedExes <- o .: "provided-exes"+ sdModules <- o .: "modules"+ return SimpleDesc {..}++data DepInfo = DepInfo+ { diComponents :: Set Component+ , diRange :: VersionRange+ }+ deriving (Show, Eq)++instance Semigroup DepInfo where+ DepInfo a x <> DepInfo b y = DepInfo+ (a <> b)+ (intersectVersionRanges x y)+instance ToJSON DepInfo where+ toJSON DepInfo {..} = object+ [ "components" .= diComponents+ , "range" .= display diRange+ ]+instance FromJSON DepInfo where+ parseJSON = withObject "DepInfo" $ \o -> do+ diComponents <- o .: "components"+ diRange <- o .: "range" >>= either (fail . show) return . simpleParse+ return DepInfo {..}++data Component = CompLibrary+ | CompExecutable+ | CompTestSuite+ | CompBenchmark+ deriving (Show, Read, Eq, Ord, Enum, Bounded)++compToText :: Component -> Text+compToText CompLibrary = "library"+compToText CompExecutable = "executable"+compToText CompTestSuite = "test-suite"+compToText CompBenchmark = "benchmark"++instance ToJSON Component where+ toJSON = toJSON . compToText+instance FromJSON Component where+ parseJSON = withText "Component" $ \t -> maybe+ (fail $ "Invalid component: " ++ unpack t)+ return+ (HashMap.lookup t comps)+ where+ comps = HashMap.fromList $ map (compToText &&& id) [minBound..maxBound]++intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange+intersectVersionRanges x y = C.simplifyVersionRange $ C.intersectVersionRanges x y
+ stackage-types.cabal view
@@ -0,0 +1,27 @@+name: stackage-types+version: 1.0.0+synopsis: Shared data types between various Stackage packages+description: For more information, see <https://www.stackage.org/package/stackage-types>+homepage: https://github.com/fpco/stackage-types+license: MIT+license-file: LICENSE+author: Michael Snoyman+maintainer: michael@fpcomplete.com+category: Data+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ exposed-modules: Stackage.Types+ build-depends: base >= 4.7 && < 5+ , Cabal+ , aeson+ , containers+ , exceptions >= 0.6+ , hashable+ , semigroups+ , text+ , unordered-containers+ , vector+ default-language: Haskell2010