From a52091af12a2df9d8caf6259c38fe3d027d19c3c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 17 Aug 2017 02:31:55 +0300 Subject: [PATCH] WIP [ci skip] --- Cabal/Cabal.cabal | 3 + Cabal/Distribution/Compat/Newtype.hs | 91 ++++++ .../Distribution/PackageDescription/Parsec.hs | 16 +- .../PackageDescription/Parsec/FieldDescr.hs | 28 -- .../Distribution/Parsec/Types/FieldParser.hs | 276 ++++++++++++++++++ Cabal/tests/ParserTests.hs | 2 + .../regressions/generics-sop.cabal | 128 ++++++++ .../regressions/generics-sop.format | 115 ++++++++ 8 files changed, 630 insertions(+), 29 deletions(-) create mode 100644 Cabal/Distribution/Compat/Newtype.hs create mode 100644 Cabal/Distribution/Parsec/Types/FieldParser.hs create mode 100644 Cabal/tests/ParserTests/regressions/generics-sop.cabal create mode 100644 Cabal/tests/ParserTests/regressions/generics-sop.format diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 110b8468bc7..f9bfeb6fa68 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -133,6 +133,7 @@ library Distribution.Compat.Graph Distribution.Compat.Internal.TempFile Distribution.Compat.Map.Strict + Distribution.Compat.Newtype Distribution.Compat.Prelude.Internal Distribution.Compat.ReadP Distribution.Compat.Semigroup @@ -281,6 +282,7 @@ library Distribution.Parsec.Types.Common Distribution.Parsec.Types.Field Distribution.Parsec.Types.FieldDescr + Distribution.Parsec.Types.FieldParser Distribution.Parsec.Types.ParseResult other-modules: @@ -380,6 +382,7 @@ test-suite parser-tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: ParserTests.hs + build-depends: containers build-depends: base, bytestring, diff --git a/Cabal/Distribution/Compat/Newtype.hs b/Cabal/Distribution/Compat/Newtype.hs new file mode 100644 index 00000000000..6c118ed84fe --- /dev/null +++ b/Cabal/Distribution/Compat/Newtype.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} +-- | Per Conor McBride, the 'Newtype' typeclass represents the packing and +-- unpacking of a newtype, and allows you to operatate under that newtype with +-- functions such as 'ala'. +module Distribution.Compat.Newtype where + +-- TODO: export only Newtype (..), ala + +import Data.Functor.Identity (Identity (..)) + +-- tmp +import Control.Applicative (many) +import Distribution.Text (Text) +import qualified Distribution.Compat.Parsec as Parsec +import Distribution.Parsec.Class + +class Newtype n o | n -> o where + pack :: o -> n + unpack :: n -> o + +instance Newtype (Identity a) a where + pack = Identity + unpack = runIdentity + +ala :: (Newtype n o, Newtype n' o') => (o -> n) -> ((o -> n) -> b -> n') -> (b -> o') +ala pa hof = ala' pa hof id + +ala' :: (Newtype n o, Newtype n' o') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> (b -> o') +ala' _ hof f = unpack . hof (pack . f) + +------------------------------------------------------------------------------- +-- Move to own module +------------------------------------------------------------------------------- + +newtype CommaListWithSep a = CommaListWithSep { getCommaListWithSep :: [a] } + +instance Newtype (CommaListWithSep a) [a] where + pack = CommaListWithSep + unpack = getCommaListWithSep + +instance Parsec a => Parsec (CommaListWithSep a) where + parsec = pack <$> parsecOptCommaList parsec + +instance Text a => Text (CommaListWithSep a) where + +-- +newtype Token = Token { getToken :: String } + +instance Parsec Token where + parsec = pack <$> parsecToken + +instance Newtype Token String where + pack = Token + unpack = getToken + +instance Text Token + +-- +newtype FreeText = FreeText { getFreeText :: String } + +instance Parsec FreeText where + parsec = pack <$> many Parsec.anyChar + +instance Newtype FreeText String where + pack = FreeText + unpack = getFreeText + +instance Text FreeText + +-- +newtype FilePathNT = FilePathNT { getFilePathNT :: FilePath } + +instance Parsec FilePathNT where + parsec = pack <$> parsecFilePath + +instance Newtype FilePathNT FilePath where + pack = FilePathNT + unpack = getFilePathNT + +instance Text FilePathNT + +------------------------------------------------------------------------------- +-- Identity +------------------------------------------------------------------------------- +-- +instance Parsec a => Parsec (Identity a) where + parsec = pack <$> parsec + +instance Text (Identity a) where diff --git a/Cabal/Distribution/PackageDescription/Parsec.hs b/Cabal/Distribution/PackageDescription/Parsec.hs index 0769a09d732..2283cfe8197 100644 --- a/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/Cabal/Distribution/PackageDescription/Parsec.hs @@ -48,6 +48,7 @@ import Distribution.Parsec.Parser import Distribution.Parsec.Types.Common import Distribution.Parsec.Types.Field (getName) import Distribution.Parsec.Types.FieldDescr +import Distribution.Parsec.Types.FieldParser import Distribution.Parsec.Types.ParseResult import Distribution.Simple.Utils (die', fromUTF8BS, warn) @@ -65,6 +66,8 @@ import System.Directory import qualified Text.Parsec as P import qualified Text.Parsec.Error as P +import Debug.Trace + -- --------------------------------------------------------------- -- Parsing @@ -297,7 +300,18 @@ parseGenericPackageDescription' lexWarnings fs = do _ -> do parseFailure pos $ "Invalid source-repository kind " ++ show args pure RepoHead - sr <- parseFields sourceRepoFieldDescrs warnUnrec (emptySourceRepo kind) fields + + let (fs, ss) = partitionFields fields + -- traverse_ (traverse_ warnSubsection) ss + + sr <- runFieldFancy fs $ SourceRepo kind -- todo "pure fields" + <$> optionalField "type" repoType + <*> optionalFieldAla "location" FreeText repoLocation + <*> optionalFieldAla "module" Token repoModule + <*> optionalFieldAla "branch" Token repoBranch + <*> optionalFieldAla "tag" Token repoTag + <*> optionalFieldAla "subdir" FilePathNT repoSubdir + -- I want lens let pd = packageDescription gpd let srs = sourceRepos pd diff --git a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs index 7daa5500f40..e9478673d77 100644 --- a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs +++ b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs @@ -27,8 +27,6 @@ module Distribution.PackageDescription.Parsec.FieldDescr ( validateBenchmark, -- * Flag flagFieldDescrs, - -- * Source repository - sourceRepoFieldDescrs, -- * Setup build info setupBInfoFieldDescrs, ) where @@ -551,32 +549,6 @@ flagFieldDescrs = flagManual (\val fl -> fl{ flagManual = val }) ] -------------------------------------------------------------------------------- --- SourceRepo -------------------------------------------------------------------------------- - -sourceRepoFieldDescrs :: [FieldDescr SourceRepo] -sourceRepoFieldDescrs = - [ simpleField "type" - (maybe mempty disp) (Just <$> parsec) - repoType (\val repo -> repo { repoType = val }) - , simpleField "location" - (maybe mempty showFreeText) (Just <$> freeTextFieldParser) - repoLocation (\val repo -> repo { repoLocation = val }) - , simpleField "module" - (maybe mempty showToken) (Just <$> parsecToken) - repoModule (\val repo -> repo { repoModule = val }) - , simpleField "branch" - (maybe mempty showToken) (Just <$> parsecToken) - repoBranch (\val repo -> repo { repoBranch = val }) - , simpleField "tag" - (maybe mempty showToken) (Just <$> parsecToken) - repoTag (\val repo -> repo { repoTag = val }) - , simpleField "subdir" - (maybe mempty showFilePath) (Just <$> parsecFilePath) - repoSubdir (\val repo -> repo { repoSubdir = val }) - ] - ------------------------------------------------------------------------------- -- SetupBuildInfo ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Parsec/Types/FieldParser.hs b/Cabal/Distribution/Parsec/Types/FieldParser.hs new file mode 100644 index 00000000000..f09dc22e9b0 --- /dev/null +++ b/Cabal/Distribution/Parsec/Types/FieldParser.hs @@ -0,0 +1,276 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} +-- | This module provides one way to parse lists of 'Field'. +-- +-- Fields can be specified multiple times in the .cabal files. +-- The order of such entries is important, but the mutual ordering of different +-- fields is non important. (The only exception is @hs-source-dirs@ and +-- @hs-source-dir@, but it can be fixed with preprocessing). +-- +-- Also conditional sections are considered after non-conditional data. +-- The example of this silent-commutation quirck is the fact that +-- +-- @ +-- buildable: True +-- if os(linux) +-- buildable: False +-- @ +-- +-- and +-- +-- @ +-- if os(linux) +-- buildable: False +-- buildable: True +-- @ +-- +-- behave the same! This is the limitation of 'GeneralPackageDescription' +-- structure. +-- +-- So we transform the list of fields @['Field' ann]@ into +-- a map of grouped ordinary fields and a list of lists of sections: +-- @'Fields' ann = 'Map' 'FieldNamee' ['NamelessField' ann]@ and @[['Section' ann]]@. +-- +-- We need list of list of sections, because we need to distinguish situations +-- where there are fields in between. For example +-- +-- @ +-- if flag(bytestring-lt-0_10_4) +-- build-depends: bytestring < 0.10.4 +-- +-- default-language: Haskell2020 +-- +-- else +-- build-depends: bytestring >= 0.10.4 +-- +-- @ +-- +-- is obviously invalid specification. +-- +-- We can parse 'Fields' like we parse @aeson@ objects, yet we use +-- slighly higher-level API, so we can process unspecified fields, +-- to report unknown fields and save custom @x-fields@. +-- +module Distribution.Parsec.Types.FieldParser ( + FieldFancy, + runFieldFancy, + optionalField, + optionalFieldAla, + partitionFields, + takeFields, + FreeText(..), + Token(..), + FilePathNT(..), + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Data.ByteString (ByteString) +import Distribution.Compat.Map.Strict (Map) +import qualified Distribution.Compat.Map.Strict as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.List (foldl') +import Data.Traversable (for) +import Data.Functor.Identity +import Data.Foldable (traverse_) + +import Distribution.Parsec.Types.Common +import Distribution.Parsec.Types.Field +import Distribution.Parsec.Types.ParseResult +import Distribution.Parsec.Class +import qualified Distribution.Compat.Parsec as Parsec +import Distribution.Compat.Newtype +import qualified Text.Parsec as P +import qualified Text.Parsec.Error as P +import Distribution.Text (Text) +import Text.PrettyPrint (Doc) +import qualified Data.ByteString as BS +import Distribution.Simple.Utils (fromUTF8BS) + +import Debug.Trace + +-- todo: move fieldName to Types.Field +type Fields ann = Map FieldNamee [NamelessField ann] + +type FieldNamee = ByteString + +-- | Single field, without name, but with its annotation. +data NamelessField ann = MkNamelessField !ann [FieldLine ann] + deriving (Eq, Show, Functor) + +-- | The 'Section' constructor of 'Field'. +data Section ann = MkSection !(Name ann) [SectionArg ann] [Field ann] + deriving (Eq, Show, Functor) + +-- | 'FieldFancy' is parametrised by +-- +-- * @s@ which is a structure we are parsing. We need this to provide prettyprinter +-- functionality +-- +-- * @a@ type of the field. +-- +-- TODO: should we call this still @FieldDescr@ ? +data FieldFancy s a = FieldFancy + { fieldFancyKnownFields :: Set FieldNamee + , fieldFancyParser :: Fields Position -> ParseResult a + -- todo: pretty + } + deriving (Functor) + +instance Applicative (FieldFancy s) where + pure x = FieldFancy mempty (\_ -> pure x) + FieldFancy f f' <*> FieldFancy x x' = + FieldFancy (mappend f x) (\fields -> f' fields <*> x' fields) + +-- | Run 'FieldFancy' in 'ParseResult' monad. +runFieldFancy :: Fields Position -> FieldFancy s a -> ParseResult a +runFieldFancy = flip fieldFancyParser -- TODO: handle unknown fields + +-- | We can use 'FieldFancy' to pretty print the @s@. +prettyFieldFancy :: FieldFancy s a -> s -> Doc +prettyFieldFancy = error "implement me" + +-- | Field which should be defined, exactly once. +uniqueField + :: (Parsec a, Text a) + => FieldNamee -- ^ field name + -> (s -> a) -- ^ getter for showing + -> FieldFancy s a +uniqueField = error "define me" + +-- | Field which can be defined at most once. +optionalField + :: (Parsec a, Text a) + => FieldNamee + -> (s -> Maybe a) + -> FieldFancy s (Maybe a) +optionalField fn = optionalFieldAla fn Identity + +optionalFieldAla + :: forall a b s. (Parsec b, Text b, Newtype b a) + => FieldNamee + -> (a -> b) -- ^ 'pack' + -> (s -> Maybe a) + -> FieldFancy s (Maybe a) +optionalFieldAla fn _pack _extract = FieldFancy (Set.singleton fn) parser + where + parser :: Fields Position -> ParseResult (Maybe a) + parser fields = case Map.lookup fn fields of + Nothing -> pure Nothing + Just [] -> pure Nothing + Just [x] -> parseOne x + Just xs -> parseOne (last xs) -- TODO: warn about duplicate optional fields? + + parseOne (MkNamelessField pos fls) = + Just . (unpack :: b -> a) <$> runFieldParser pos parsec fls + + + +-- | Field which can be define multiple times, and the results are @mappend@ed. +monoidField + :: (Parsec a, Text a, Monoid a) + => FieldNamee -- ^ field name + -> (s -> a) -- ^ getter for showing + -> FieldFancy s a +monoidField = error "define me" + +monoidFieldAla + :: (Parsec b, Text b, Monoid a, Newtype b a) + => FieldNamee + -> (a -> b) -- ^ 'pack' + -> (s -> a) -- ^ getter for showing + -> FieldFancy s a +monoidFieldAla = error "define me" + +-- | Parser matching all fields with a name starting with a prefix. +prefixFieldFancy + :: FieldNamee -- ^Prefix + -> (s -> [(String, String)]) -- ^ getter for showing + -> FieldFancy s [(String, String)] +prefixFieldFancy = error "define me" + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +-- | Partitionin state +data PS ann = PS (Fields ann) [Section ann] [[Section ann]] + +-- | Partition field list into field map and groups of sections. +partitionFields :: [Field ann] -> (Fields ann, [[Section ann]]) +partitionFields = finalize . foldl' f (PS mempty mempty mempty) + where + finalize :: PS ann -> (Fields ann, [[Section ann]]) + finalize (PS fs s ss) + | null s = (fs, reverse ss) + | otherwise = (fs, reverse (reverse s : ss)) + + f :: PS ann -> Field ann -> PS ann + f (PS fs s ss) (Field (Name ann name) fss) = + PS (Map.insertWith (++) name [MkNamelessField ann fss] fs) [] ss' + where + ss' | null s = ss + | otherwise = reverse s : ss + f (PS fs s ss) (Section name sargs sfields) = + PS fs (MkSection name sargs sfields : s) ss + + +-- | Take all fields from the front. +takeFields :: [Field ann] -> (Fields ann, [Field ann]) +takeFields = finalize . spanMaybe match + where + finalize (fs, rest) = (Map.fromListWith (++) fs, rest) + + match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs]) + match _ = Nothing + +spanMaybe :: (a -> Maybe b) -> [a] -> ([b],[a]) +spanMaybe _ xs@[] = ([], xs) +spanMaybe p xs@(x:xs') = case p x of + Just y -> let (ys, zs) = spanMaybe p xs' in (y : ys, zs) + Nothing -> ([], xs) + +------------------------------------------------------------------------------- +-- Parsec +------------------------------------------------------------------------------- + +runFieldParser' :: Position -> FieldParser a -> String -> ParseResult a +runFieldParser' (Position row col) p str = case P.runParser p' [] "" str of + Right (pok, ws) -> do + -- TODO: map pos + traverse_ (\(PWarning t pos w) -> parseWarning pos t w) ws + pure pok + Left err -> do + let ppos = P.errorPos err + -- Positions start from 1:1, not 0:0 + let epos = Position (row - 1 + P.sourceLine ppos) (col - 1 + P.sourceColumn ppos) + let msg = P.showErrorMessages + "or" "unknown parse error" "expecting" "unexpected" "end of input" + (P.errorMessages err) + + parseFatalFailure epos $ msg ++ ": " ++ show str + where + p' = (,) <$ P.spaces <*> p <* P.spaces <* P.eof <*> P.getState + +runFieldParser :: Position -> FieldParser a -> [FieldLine Position] -> ParseResult a +runFieldParser pp p ls = runFieldParser' pos p =<< fieldlinesToString pos ls + where + -- TODO: make per line lookup + pos = case ls of + [] -> pp + (FieldLine pos' _ : _) -> pos' + +fieldlinesToBS :: [FieldLine ann] -> BS.ByteString +fieldlinesToBS = BS.intercalate "\n" . map (\(FieldLine _ bs) -> bs) + +-- TODO: Take position from FieldLine +-- TODO: Take field name +fieldlinesToString :: Position -> [FieldLine ann] -> ParseResult String +fieldlinesToString pos fls = + let str = intercalate "\n" . map (\(FieldLine _ bs') -> fromUTF8BS bs') $ fls + in if '\xfffd' `elem` str + then str <$ parseWarning pos PWTUTF "Invalid UTF8 encoding" + else pure str diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs index 71d1165c675..a74d5ea458d 100644 --- a/Cabal/tests/ParserTests.hs +++ b/Cabal/tests/ParserTests.hs @@ -51,6 +51,7 @@ warningTests = testGroup "warnings triggered" warningTest :: PWarnType -> FilePath -> TestTree warningTest wt fp = testCase (show wt) $ do contents <- BS.readFile $ "tests" "ParserTests" "warnings" fp + let res = parseGenericPackageDescription contents let (warns, errs, x) = runParseResult res @@ -71,6 +72,7 @@ regressionTests = testGroup "regressions" [ regressionTest "encoding-0.8.cabal" , regressionTest "Octree-0.5.cabal" , regressionTest "nothing-unicode.cabal" + , regressionTest "generics-sop.cabal" ] regressionTest :: FilePath -> TestTree diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.cabal b/Cabal/tests/ParserTests/regressions/generics-sop.cabal new file mode 100644 index 00000000000..e8932980912 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/generics-sop.cabal @@ -0,0 +1,128 @@ +name: generics-sop +version: 0.3.1.0 +synopsis: Generic Programming using True Sums of Products +description: + A library to support the definition of generic functions. + Datatypes are viewed in a uniform, structured way: + the choice between constructors is represented using an n-ary + sum, and the arguments of each constructor are represented using + an n-ary product. + . + The module "Generics.SOP" is the main module of this library and contains + more detailed documentation. + . + Examples of using this library are provided by the following + packages: + . + * @@ basic examples, + . + * @@ generic pretty printing, + . + * @@ generically computed lenses, + . + * @@ generic JSON conversions. + . + A detailed description of the ideas behind this library is provided by + the paper: + . + * Edsko de Vries and Andres Löh. + . + Workshop on Generic Programming (WGP) 2014. + . +license: BSD3 +license-file: LICENSE +author: Edsko de Vries , Andres Löh +maintainer: andres@well-typed.com +category: Generics +build-type: Custom +cabal-version: >=1.10 +extra-source-files: CHANGELOG.md +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1, GHC == 8.3.* + +custom-setup + setup-depends: + base, + Cabal, + cabal-doctest >= 1.0.2 && <1.1 + +source-repository head + type: git + location: https://github.com/well-typed/generics-sop + +library + exposed-modules: Generics.SOP + Generics.SOP.GGP + Generics.SOP.TH + Generics.SOP.Dict + Generics.SOP.Type.Metadata + -- exposed via Generics.SOP: + Generics.SOP.BasicFunctors + Generics.SOP.Classes + Generics.SOP.Constraint + Generics.SOP.Instances + Generics.SOP.Metadata + Generics.SOP.NP + Generics.SOP.NS + Generics.SOP.Universe + Generics.SOP.Sing + build-depends: base >= 4.7 && < 5, + template-haskell >= 2.8 && < 2.13, + ghc-prim >= 0.3 && < 0.6, + deepseq >= 1.3 && < 1.5 + if !impl (ghc >= 7.8) + build-depends: tagged >= 0.7 && < 0.9 + if !impl (ghc >= 8.0) + build-depends: transformers-compat >= 0.3 && < 0.6, + transformers >= 0.3 && < 0.6 + + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: CPP + ScopedTypeVariables + TypeFamilies + RankNTypes + TypeOperators + GADTs + ConstraintKinds + MultiParamTypeClasses + TypeSynonymInstances + FlexibleInstances + FlexibleContexts + DeriveFunctor + DeriveFoldable + DeriveTraversable + DefaultSignatures + KindSignatures + DataKinds + FunctionalDependencies + if impl (ghc >= 7.8) + default-extensions: AutoDeriveTypeable + other-extensions: OverloadedStrings + PolyKinds + UndecidableInstances + TemplateHaskell + DeriveGeneric + StandaloneDeriving + if impl (ghc < 7.10) + other-extensions: OverlappingInstances + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + x-doctest-options: --preserve-it + hs-source-dirs: test + default-language: Haskell2010 + build-depends: base, + doctest >= 0.13 && <0.14 + ghc-options: -Wall -threaded + +test-suite generics-sop-examples + type: exitcode-stdio-1.0 + main-is: Example.hs + other-modules: HTransExample + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall + build-depends: base >= 4.6 && < 5, + generics-sop diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.format b/Cabal/tests/ParserTests/regressions/generics-sop.format new file mode 100644 index 00000000000..42873aff0ec --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/generics-sop.format @@ -0,0 +1,115 @@ +name: generics-sop +version: 0.3.1.0 +cabal-version: >=1.10 +build-type: Custom +license: BSD3 +license-file: LICENSE +maintainer: andres@well-typed.com +synopsis: Generic Programming using True Sums of Products +description: + A library to support the definition of generic functions. + Datatypes are viewed in a uniform, structured way: + the choice between constructors is represented using an n-ary + sum, and the arguments of each constructor are represented using + an n-ary product. + . + The module "Generics.SOP" is the main module of this library and contains + more detailed documentation. + . + Examples of using this library are provided by the following + packages: + . + * @@ basic examples, + . + * @@ generic pretty printing, + . + * @@ generically computed lenses, + . + * @@ generic JSON conversions. + . + A detailed description of the ideas behind this library is provided by + the paper: + . + * Edsko de Vries and Andres Löh. + . + Workshop on Generic Programming (WGP) 2014. + . +category: Generics +author: Edsko de Vries , Andres Löh +tested-with: GHC ==7.8.4 GHC ==7.10.3 GHC ==8.0.1 GHC ==8.0.2 + GHC ==8.2.1 GHC ==8.3.* +extra-source-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/well-typed/generics-sop + +library + + if !impl(ghc >=7.8) + build-depends: + tagged >=0.7 && <0.9 + + if !impl(ghc >=8.0) + build-depends: + transformers-compat >=0.3 && <0.6, + transformers >=0.3 && <0.6 + + if impl(ghc >=7.8) + default-extensions: AutoDeriveTypeable + + if impl(ghc <7.10) + other-extensions: OverlappingInstances + exposed-modules: + Generics.SOP + Generics.SOP.GGP + Generics.SOP.TH + Generics.SOP.Dict + Generics.SOP.Type.Metadata + Generics.SOP.BasicFunctors + Generics.SOP.Classes + Generics.SOP.Constraint + Generics.SOP.Instances + Generics.SOP.Metadata + Generics.SOP.NP + Generics.SOP.NS + Generics.SOP.Universe + Generics.SOP.Sing + build-depends: + base >=4.7 && <5, + template-haskell >=2.8 && <2.13, + ghc-prim >=0.3 && <0.6, + deepseq >=1.3 && <1.5 + default-language: Haskell2010 + default-extensions: CPP ScopedTypeVariables TypeFamilies RankNTypes + TypeOperators GADTs ConstraintKinds MultiParamTypeClasses + TypeSynonymInstances FlexibleInstances FlexibleContexts + DeriveFunctor DeriveFoldable DeriveTraversable DefaultSignatures + KindSignatures DataKinds FunctionalDependencies + other-extensions: OverloadedStrings PolyKinds UndecidableInstances + TemplateHaskell DeriveGeneric StandaloneDeriving + hs-source-dirs: src + ghc-options: -Wall + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + build-depends: + base -any, + doctest >=0.13 && <0.14 + default-language: Haskell2010 + hs-source-dirs: test + ghc-options: -Wall -threaded + x-doctest-options: --preserve-it +test-suite generics-sop-examples + type: exitcode-stdio-1.0 + main-is: Example.hs + build-depends: + base >=4.6 && <5, + generics-sop -any + default-language: Haskell2010 + hs-source-dirs: test + other-modules: + HTransExample + ghc-options: -Wall