Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated 2 months ago

total matches: more than 1000

Cabal-2.4.1.0
26 matches
tests/HackageTests.hs
import Control.Monad                               (join, unless)
import Data.Foldable                               (traverse_)
import Data.List                                   (isPrefixOf, isSuffixOf)
import Data.Maybe                                  (mapMaybe)
import Data.Monoid                                 (Sum (..))
import Distribution.PackageDescription.Check       (PackageCheck (..)
                                                   ,checkPackage)
import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
import Distribution.Simple.Utils                   (toUTF8BS)

            
tests/HackageTests.hs
newtype M k v = M (Map.Map k v)
    deriving (Show)
instance (Ord k, Monoid v) => Semigroup (M k v) where
    M a <> M b = M (Map.unionWith mappend a b)
instance (Ord k, Monoid v) => Monoid (M k v) where
    mempty = M Map.empty
    mappend = (<>)
instance (NFData k, NFData v) => NFData (M k v) where
    rnf (M m) = rnf m

parseParsecTest :: FilePath -> BSL.ByteString -> IO (Sum Int)
parseParsecTest fpath bsl = do

            
tests/HackageTests.hs

instance Monoid CheckResult where
    mempty = CheckResult 0 0 0 0 0 0
    mappend = (<>)

toCheckResult :: PackageCheck -> CheckResult
toCheckResult PackageBuildImpossible {}    = CheckResult 0 1 0 0 0 0
toCheckResult PackageBuildWarning {}       = CheckResult 0 0 1 0 0 0
toCheckResult PackageDistSuspicious {}     = CheckResult 0 0 0 1 0 0

            
tests/HackageTests.hs
        putStrLn $ show d ++ " build dist suspicious warning"
        putStrLn $ show e ++ " build dist inexcusable"

    prefixP = fmap mkPredicate $ many $ O.strArgument $ mconcat
        [ O.metavar "PREFIX"
        , O.help "Check only files starting with a prefix"
        ]

    mkPredicate [] = const True

            
tests/HackageTests.hs

-- TODO: Use 'Cabal' for this?
reposFromConfig :: [Parsec.Field ann] -> [String]
reposFromConfig fields = takeWhile (/= ':') <$> mapMaybe f fields
  where
    f (Parsec.Field (Parsec.Name _ name) fieldLines)
        | B8.unpack name == "remote-repo" =
            Just $ fieldLinesToString fieldLines
    f (Parsec.Section (Parsec.Name _ name)

            
tests/HackageTests.hs

-- | Looks up the given key in the cabal configuration file
lookupInConfig :: String -> [Parsec.Field ann] -> [String]
lookupInConfig key = mapMaybe f
  where
    f (Parsec.Field (Parsec.Name _ name) fieldLines)
        | B8.unpack name == key =
            Just $ fieldLinesToString fieldLines
    f _ = Nothing

            
tests/HackageTests.hs
    go !acc [] = return acc
    go !acc (x : xs) = do
        y <- f x
        go (mappend acc y) xs

-------------------------------------------------------------------------------
-- Orphans
-------------------------------------------------------------------------------


            
tests/ParserTests.hs
            "UNXPECTED SUCCESS\n" ++
            showGenericPackageDescription gpd
        Left (v, errs) ->
            unlines $ ("VERSION: " ++ show v) : map (showPError fp) errs
  where
    input = "tests" </> "ParserTests" </> "errors" </> fp
    correct = replaceExtension input "errors"

-------------------------------------------------------------------------------

            
tests/ParserTests.hs

    return $ toUTF8BS $ case x of
        Right gpd ->
            unlines (map (showPWarning fp) warns)
            ++ showGenericPackageDescription gpd
        Left (_, errs) ->
            unlines $ "ERROR" : map (showPError fp) errs
  where
    input = "tests" </> "ParserTests" </> "regressions" </> fp
    correct = replaceExtension input "format"

#ifdef MIN_VERSION_tree_diff

            
tests/ParserTests.hs
    let (_, x) = runParseResult res
    case x of
        Right gpd      -> pure (toExpr gpd)
        Left (_, errs) -> fail $ unlines $ "ERROR" : map (showPError fp) errs
  where
    input = "tests" </> "ParserTests" </> "regressions" </> fp
    exprFile = replaceExtension input "expr"
#endif


            
tests/ParserTests.hs
        case x' of
            Right gpd      -> pure gpd
            Left (_, errs) -> do
                void $ assertFailure $ unlines (map (showPError fp) errs)
                fail "failure"
    input = "tests" </> "ParserTests" </> "regressions" </> fp

-------------------------------------------------------------------------------
-- InstalledPackageInfo regressions

            
tests/ParserTests.hs
    return $ toUTF8BS $ case res of
        ReadP.ParseFailed err -> "ERROR " ++ show err
        ReadP.ParseOk ws ipi  ->
            unlines (map (ReadP.showPWarning fp) ws)
            ++ IPI.showInstalledPackageInfo ipi
  where
    input = "tests" </> "ParserTests" </> "ipi" </> fp
    correct = replaceExtension input "format"


            
tests/ParserTests.hs
    cmp x y = return $ Just $ unlines $
        concatMap f (getGroupedDiff (BS8.lines x) (BS8.lines y))
      where
        f (First xs)  = map (cons3 '-' . fromUTF8BS) xs
        f (Second ys) = map (cons3 '+' . fromUTF8BS) ys
        -- we print unchanged lines too. It shouldn't be a problem while we have
        -- reasonably small examples
        f (Both xs _) = map (cons3 ' ' . fromUTF8BS) xs
        -- we add three characters, so the changed lines are easier to spot
        cons3 c cs = c : c : c : ' ' : cs

            
tests/UnitTests/Distribution/SPDX.hs
-------------------------------------------------------------------------------

shouldAccept :: [License]
shouldAccept = map License
    [ simpleLicenseExpression GPL_2_0_only
    , simpleLicenseExpression GPL_2_0_or_later
    , simpleLicenseExpression BSD_2_Clause
    , simpleLicenseExpression BSD_3_Clause
    , simpleLicenseExpression MIT

            
tests/UnitTests/Distribution/SPDX.hs
    ]

shouldReject :: [License]
shouldReject = map License
    [ simpleLicenseExpression BSD_4_Clause
    , simpleLicenseExpression BSD_4_Clause `EAnd` simpleLicenseExpression MIT
    ]

-- | A sketch of what Hackage could accept

            
tests/UnitTests/Distribution/SPDX.hs

shouldAcceptProp :: Property
shouldAcceptProp = conjoin $
    map (\l -> counterexample (prettyShow l) (isAcceptableLicense l)) shouldAccept

shouldRejectProp :: Property
shouldRejectProp = conjoin $
    map (\l -> counterexample (prettyShow l) (not $ isAcceptableLicense l)) shouldReject

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------


            
tests/UnitTests/Distribution/SPDX.hs
                arbA = arb m 
                arbB = arb (n - m)

    shrink (EAnd a b) = a : b : map (uncurry EAnd) (shrink (a, b))
    shrink (EOr a b)  = a : b : map (uncurry EOr) (shrink (a, b))
    shrink _          = []


            
tests/UnitTests/Distribution/Utils/NubList.hs

prop_Identity :: [Int] -> Bool
prop_Identity xs =
    mempty `mappend` toNubList xs == toNubList xs `mappend` mempty

prop_Associativity :: [Int] -> [Int] -> [Int] -> Bool
prop_Associativity xs ys zs =
    (toNubList xs `mappend` toNubList ys) `mappend` toNubList zs
            == toNubList xs `mappend` (toNubList ys `mappend` toNubList zs)

            
tests/UnitTests/Distribution/Version.hs
        unionVersionRanges (EarlierVersion v) (ThisVersion v)

  shrink AnyVersion                   = []
  shrink (ThisVersion v)              = map ThisVersion (shrink v)
  shrink (LaterVersion v)             = map LaterVersion (shrink v)
  shrink (EarlierVersion v)           = map EarlierVersion (shrink v)
  shrink (OrLaterVersion v)           = LaterVersion v : map OrLaterVersion (shrink v)
  shrink (OrEarlierVersion v)         = EarlierVersion v : map OrEarlierVersion (shrink v)
  shrink (WildcardVersion v)          = map WildcardVersion ( shrink v)
  shrink (MajorBoundVersion v)        = map MajorBoundVersion (shrink v)
  shrink (VersionRangeParens vr)      = vr : map VersionRangeParens (shrink vr)
  shrink (UnionVersionRanges a b)     = a : b : map (uncurry UnionVersionRanges) (shrink (a, b))
  shrink (IntersectVersionRanges a b) = a : b : map (uncurry IntersectVersionRanges) (shrink (a, b))

---------------------
-- Version properties
--


            
tests/UnitTests/Distribution/Version.hs
prop_VersionId lst0 =
    (versionNumbers . mkVersion) lst == lst
  where
    lst = map getNonNegative lst0

prop_VersionId2 :: VersionArb -> Bool
prop_VersionId2 (VersionArb lst) =
    (versionNumbers . mkVersion) lst == lst


            
tests/UnitTests/Distribution/Version.hs
--

instance Arbitrary VersionIntervals where
  arbitrary = fmap mkVersionIntervals' arbitrary
    where
      mkVersionIntervals' :: [(Version, Bound)] -> VersionIntervals
      mkVersionIntervals' = mkVersionIntervals . go version0
        where
          go :: Version -> [(Version, Bound)] -> [VersionInterval]

            
tests/UnitTests/Distribution/Version.hs

prop_parse_disp :: VersionRange -> Property
prop_parse_disp vr = counterexample (show (display vr')) $
    fmap s (simpleParse (display vr')) === Just vr'
    .&&.
    fmap s (simpleParsec (display vr')) === Just vr'
  where
    -- we have to strip parens, because arbitrary 'VersionRange' may have
    -- too little parens constructors.
    s = stripParensVersionRange
    vr' = s vr

            
tests/UnitTests/Distribution/Version.hs

prop_parse_disp1 :: VersionRange -> Bool
prop_parse_disp1 vr =
    fmap stripParens (simpleParse (display vr)) == Just (normaliseVersionRange vr)
  where
    stripParens :: VersionRange -> VersionRange
    stripParens (VersionRangeParens v) = stripParens v
    stripParens (UnionVersionRanges v1 v2) =
      UnionVersionRanges (stripParens v1) (stripParens v2)

            
tests/UnitTests/Distribution/Version.hs

prop_parse_disp2 :: VersionRange -> Property
prop_parse_disp2 vr =
  let b = fmap (display :: VersionRange -> String) (simpleParse (display vr))
      a = Just (display vr)
  in
   counterexample ("Expected: " ++ show a) $
   counterexample ("But got: " ++ show b) $
   b == a

            
tests/UnitTests/Distribution/Version.hs
prop_parse_disp3 :: VersionRange -> Property
prop_parse_disp3 vr =
  let a = Just (display vr)
      b = fmap displayRaw (simpleParse (display vr))
  in
   counterexample ("Expected: " ++ show a) $
   counterexample ("But got: " ++ show b) $
   b == a


            
tests/UnitTests/Distribution/Version.hs
  where
    dispWild v =
           Disp.hcat (Disp.punctuate (Disp.char '.')
                                     (map Disp.int (versionNumbers v)))
        <<>> Disp.text ".*"

            
JuicyPixels-scale-dct-0.1.2
4 matches
src/Codec/Picture/ScaleDCT.hs
       (Image (..), PixelRGBA8 (..), Traversal, generateImage, imagePixels)
import Control.Applicative (Const (..))
import Data.Array.CArray
       (CArray, amap, array, bounds, elems, listArray, size, (!))
import Data.Coerce         (Coercible, coerce)
import Data.Ix             (inRange, range)
import Data.Monoid         (Endo (..))
import Data.Word           (Word8)
import Math.FFT            (dct1N, dct2N, dct3N)

            
src/Codec/Picture/ScaleDCT.hs
    b = channelB img
    a = channelA img

    transform ch = amap (k*) ch'
      where
        ch' = dct3N [1, 0] . cutImpl . dct2N [0, 1] $ ch
        k = imgNorm ch / imgNorm ch'

    r' = transform r

            
src/Codec/Picture/ScaleDCT.hs
    a' = transform a

imgNorm :: Array2D -> Double
imgNorm ch = sqrt . (/n) . sum . fmap sq . elems $ ch
  where
    sq x = x * x
    n = fromIntegral $ size ch

cut :: (Int, Int) -> Array2D -> Array2D

            
src/Codec/Picture/ScaleDCT.hs
extractChannel :: (PixelRGBA8 -> Word8) -> Image PixelRGBA8 -> Array2D
extractChannel f img@(Image w h _)
    = listArray ((0, 0), (h - 1, w - 1))
    . map (fromInteger . toInteger . f)
    . toListOf imagePixels
    $ img

channelR, channelG, channelB, channelA :: Image PixelRGBA8 -> Array2D
channelR = extractChannel pixelR