|
| 1 | +{-# LANGUAGE RankNTypes #-} |
| 2 | +{-# LANGUAGE OverloadedStrings #-} |
| 3 | +-- | |
| 4 | +-- |
| 5 | +-- @since 2.2.0.0 |
| 6 | +module Distribution.PackageDescription.Parsec.Legacy (patchLegacy) where |
| 7 | + |
| 8 | +import Prelude () |
| 9 | +import Distribution.Compat.Prelude |
| 10 | +import GHC.Fingerprint (Fingerprint (..), fingerprintData) |
| 11 | +import Foreign.Ptr (castPtr) |
| 12 | +import System.IO.Unsafe (unsafeDupablePerformIO) |
| 13 | + |
| 14 | +import qualified Data.ByteString as BS |
| 15 | +import qualified Data.ByteString.Unsafe as BS |
| 16 | +import qualified Data.Map as Map |
| 17 | + |
| 18 | +-- | Patch legacy @.cabal@ file contents to allow parsec parser to accept |
| 19 | +-- all of Hackage. |
| 20 | +-- |
| 21 | +-- Bool part of the result tells whether the output is modified. |
| 22 | +-- |
| 23 | +-- @since 2.2.0.0 |
| 24 | +patchLegacy :: BS.ByteString -> (Bool, BS.ByteString) |
| 25 | +patchLegacy bs = case Map.lookup (BS.take 256 bs, md5 bs) patches of |
| 26 | + Nothing -> (False, bs) |
| 27 | + Just (post, f) |
| 28 | + | post /= md5 output -> (False, bs) |
| 29 | + | otherwise -> (True, output) |
| 30 | + where |
| 31 | + output = f bs |
| 32 | + |
| 33 | +md5 :: BS.ByteString -> Fingerprint |
| 34 | +md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) -> |
| 35 | + fingerprintData (castPtr ptr) len |
| 36 | + |
| 37 | +-- | 'patches' contains first 256 bytes, pre- and post-fingerprints and a patch function. |
| 38 | +-- |
| 39 | +-- |
| 40 | +patches :: Map.Map (BS.ByteString, Fingerprint) (Fingerprint, BS.ByteString -> BS.ByteString) |
| 41 | +patches = Map.fromList |
| 42 | + -- http://hackage.haskell.org/package/unicode-transforms-0.3.3 |
| 43 | + -- other-modules: . |
| 44 | + -- ReadP assumed dot is empty line |
| 45 | + [ mk "-- This file has been generated from package.yaml by hpack version 0.17.0.\n--\n-- see: https://github.com/sol/hpack\n\nname: unicode-transforms\nversion: 0.3.3\nsynopsis: Unicode normalization\ndescription: Fast Unic" |
| 46 | + (Fingerprint 15958160436627155571 10318709190730872881) |
| 47 | + (Fingerprint 11008465475756725834 13815629925116264363) |
| 48 | + (bsRemove " other-modules:\n .\n") -- TODO: remove traling \n to test structural-diff |
| 49 | + -- http://hackage.haskell.org/package/DSTM-0.1.2 |
| 50 | + -- http://hackage.haskell.org/package/DSTM-0.1.1 |
| 51 | + -- http://hackage.haskell.org/package/DSTM-0.1 |
| 52 | + -- Other Modules: no dash |
| 53 | + -- ReadP parsed as section |
| 54 | + , mk "Name: DSTM\nVersion: 0.1.2\nCopyright: (c) 2010, Frank Kupke\nLicense: LGPL\nLicense-File: LICENSE\nAuthor: Frank Kupke\nMaintainer: [email protected]\nCabal-Version: >= 1.2.3\nStability: provisional\nSynopsis: A framework for using STM within distributed " |
| 55 | + (Fingerprint 6919263071548559054 9050746360708965827) |
| 56 | + (Fingerprint 17015177514298962556 11943164891661867280) |
| 57 | + (bsReplace "Other modules:" "-- ") |
| 58 | + , mk "Name: DSTM\nVersion: 0.1.1\nCopyright: (c) 2010, Frank Kupke\nLicense: LGPL\nLicense-File: LICENSE\nAuthor: Frank Kupke\nMaintainer: [email protected]\nCabal-Version: >= 1.2.3\nStability: provisional\nSynopsis: A framework for using STM within distributed " |
| 59 | + (Fingerprint 17313105789069667153 9610429408495338584) |
| 60 | + (Fingerprint 17250946493484671738 17629939328766863497) |
| 61 | + (bsReplace "Other modules:" "-- ") |
| 62 | + , mk "Name: DSTM\nVersion: 0.1\nCopyright: (c) 2010, Frank Kupke\nLicense: LGPL\nLicense-File: LICENSE\nAuthor: Frank Kupke\nMaintainer: [email protected]\nCabal-Version: >= 1.2.3\nStability: provisional\nSynopsis: A framework for using STM within distributed sy" |
| 63 | + (Fingerprint 10502599650530614586 16424112934471063115) |
| 64 | + (Fingerprint 13562014713536696107 17899511905611879358) |
| 65 | + (bsReplace "Other modules:" "-- ") |
| 66 | + -- http://hackage.haskell.org/package/control-monad-exception-mtl-0.10.3 |
| 67 | + , mk "name: control-monad-exception-mtl\nversion: 0.10.3\nCabal-Version: >= 1.10\nbuild-type: Simple\nlicense: PublicDomain\nauthor: Pepe Iborra\nmaintainer: [email protected]\nhomepage: http://pepeiborra.github.com/control-monad-exception\nsynopsis: MTL instances f" |
| 68 | + (Fingerprint 18274748422558568404 4043538769550834851) |
| 69 | + (Fingerprint 11395257416101232635 4303318131190196308) |
| 70 | + (bsReplace " default- extensions:" "unknown-section") |
| 71 | + -- http://hackage.haskell.org/package/vacuum-opengl-0.0 |
| 72 | + -- \DEL character |
| 73 | + , mk "Name: vacuum-opengl\nVersion: 0.0\nSynopsis: Visualize live Haskell data structures using vacuum, graphviz and OpenGL.\nDescription: \DELVisualize live Haskell data structures using vacuum, graphviz and OpenGL.\n " |
| 74 | + (Fingerprint 5946760521961682577 16933361639326309422) |
| 75 | + (Fingerprint 14034745101467101555 14024175957788447824) |
| 76 | + (bsRemove "\DEL") |
| 77 | + , mk "Name: vacuum-opengl\nVersion: 0.0.1\nSynopsis: Visualize live Haskell data structures using vacuum, graphviz and OpenGL.\nDescription: \DELVisualize live Haskell data structures using vacuum, graphviz and OpenGL.\n " |
| 78 | + (Fingerprint 10790950110330119503 1309560249972452700) |
| 79 | + (Fingerprint 1565743557025952928 13645502325715033593) |
| 80 | + (bsRemove "\DEL") |
| 81 | + -- http://hackage.haskell.org/package/ixset-1.0.4 |
| 82 | + -- {- comments -} |
| 83 | + , mk "Name: ixset\nVersion: 1.0.4\nSynopsis: Efficient relational queries on Haskell sets.\nDescription:\n Create and query sets that are indexed by multiple indices.\nLicense: BSD3\nLicense-file: COPYING\nAut" |
| 84 | + (Fingerprint 11886092342440414185 4150518943472101551) |
| 85 | + (Fingerprint 5731367240051983879 17473925006273577821) |
| 86 | + (bsRemoveStarting "{-") |
| 87 | + -- : after section |
| 88 | + -- http://hackage.haskell.org/package/ds-kanren |
| 89 | + , mk "name: ds-kanren\nversion: 0.2.0.0\nsynopsis: A subset of the miniKanren language\ndescription:\n ds-kanren is an implementation of the <http://minikanren.org miniKanren> language.\n .\n == What's in ds-kanren?\n .\n ['dis" |
| 90 | + (Fingerprint 2804006762382336875 9677726932108735838) |
| 91 | + (Fingerprint 9830506174094917897 12812107316777006473) |
| 92 | + (bsReplace "Test-Suite test-unify:" "Test-Suite \"test-unify:\"" . bsReplace "Test-Suite test-list-ops:" "Test-Suite \"test-list-ops:\"") |
| 93 | + , mk "name: ds-kanren\nversion: 0.2.0.1\nsynopsis: A subset of the miniKanren language\ndescription:\n ds-kanren is an implementation of the <http://minikanren.org miniKanren> language.\n\nlicense: MIT\nlicense-file: " |
| 94 | + (Fingerprint 9130259649220396193 2155671144384738932) |
| 95 | + (Fingerprint 1847988234352024240 4597789823227580457) |
| 96 | + (bsReplace "Test-Suite test-unify:" "Test-Suite \"test-unify:\"" . bsReplace "Test-Suite test-list-ops:" "Test-Suite \"test-list-ops:\"") |
| 97 | + , mk "name: metric\nversion: 0.1.4\nsynopsis: Metric spaces.\nlicense: MIT\nlicense-file: LICENSE\nauthor: Vikram Verma\nmaintainer: [email protected]\ncategory: Data\nbuild-type:" |
| 98 | + (Fingerprint 6150019278861565482 3066802658031228162) |
| 99 | + (Fingerprint 9124826020564520548 15629704249829132420) |
| 100 | + (bsReplace "test-suite metric-tests:" "test-suite \"metric-tests:\"") |
| 101 | + , mk "name: metric\nversion: 0.2.0\nsynopsis: Metric spaces.\nlicense: MIT\nlicense-file: LICENSE\nauthor: Vikram Verma\nmaintainer: [email protected]\ncategory: Data\nbuild-type:" |
| 102 | + (Fingerprint 4639805967994715694 7859317050376284551) |
| 103 | + (Fingerprint 5566222290622325231 873197212916959151) |
| 104 | + (bsReplace "test-suite metric-tests:" "test-suite \"metric-tests:\"") |
| 105 | + , mk "name: phasechange\ncategory: Data\nversion: 0.1\nauthor: G\195\161bor Lehel\nmaintainer: G\195\161bor Lehel <[email protected]>\nhomepage: http://github.com/glehel/phasechange\ncopyright: Copyright (C) 2012 G\195\161bor Lehel\nlicense: " |
| 106 | + (Fingerprint 10546509771395401582 245508422312751943) |
| 107 | + (Fingerprint 5169853482576003304 7247091607933993833) |
| 108 | + (bsReplace "impl(ghc >= 7.4):" "erroneous-section" . bsReplace "impl(ghc >= 7.6):" "erroneous-section") |
| 109 | + , mk "Name: smartword\nSynopsis: Web based flash card for Word Smart I and II vocabularies\nVersion: 0.0.0.5\nHomepage: http://kyagrd.dyndns.org/~kyagrd/project/smartword/\nCategory: Web,Education\nLicense: " |
| 110 | + (Fingerprint 7803544783533485151 10807347873998191750) |
| 111 | + (Fingerprint 1665635316718752601 16212378357991151549) |
| 112 | + (bsReplace "build depends:" "--") |
| 113 | + , mk "name: shelltestrunner\n-- sync with README.md, ANNOUNCE:\nversion: 1.3\ncategory: Testing\nsynopsis: A tool for testing command-line programs.\ndescription:\n shelltestrunner is a cross-platform tool for testing command-line\n program" |
| 114 | + (Fingerprint 4403237110790078829 15392625961066653722) |
| 115 | + (Fingerprint 10218887328390239431 4644205837817510221) |
| 116 | + (bsReplace "other modules:" "--") |
| 117 | + ] |
| 118 | + where |
| 119 | + mk a b c d = ((a, b), (c, d)) |
| 120 | + |
| 121 | +-- | Helper to create entries in patches |
| 122 | +_makePatchKey :: FilePath -> (BS.ByteString -> BS.ByteString) -> NoCallStackIO () |
| 123 | +_makePatchKey fp transform = do |
| 124 | + contents <- BS.readFile fp |
| 125 | + let output = transform contents |
| 126 | + let Fingerprint hi lo = md5 contents |
| 127 | + let Fingerprint hi' lo' = md5 output |
| 128 | + putStrLn |
| 129 | + $ showString " , mk " |
| 130 | + . shows (BS.take 256 contents) |
| 131 | + . showString "\n (Fingerprint " |
| 132 | + . shows hi |
| 133 | + . showString " " |
| 134 | + . shows lo |
| 135 | + . showString ")\n (Fingerprint " |
| 136 | + . shows hi' |
| 137 | + . showString " " |
| 138 | + . shows lo' |
| 139 | + . showString ")" |
| 140 | + $ "" |
| 141 | + |
| 142 | +------------------------------------------------------------------------------- |
| 143 | +-- Patch helpers |
| 144 | +------------------------------------------------------------------------------- |
| 145 | + |
| 146 | +bsRemove |
| 147 | + :: BS.ByteString -- ^ needle |
| 148 | + -> BS.ByteString -> BS.ByteString |
| 149 | +bsRemove needle haystack = case BS.breakSubstring needle haystack of |
| 150 | + (h, t) -> BS.append h (BS.drop (BS.length needle) t) |
| 151 | + |
| 152 | +bsReplace |
| 153 | + :: BS.ByteString -- ^ needle |
| 154 | + -> BS.ByteString -- ^ replacement |
| 155 | + -> BS.ByteString -> BS.ByteString |
| 156 | +bsReplace needle repl haystack = case BS.breakSubstring needle haystack of |
| 157 | + (h, t) |
| 158 | + | not (BS.null t) -> BS.append h (BS.append repl (BS.drop (BS.length needle) t)) |
| 159 | + | otherwise -> haystack |
| 160 | + |
| 161 | +bsRemoveStarting |
| 162 | + :: BS.ByteString -- ^ needle |
| 163 | + -> BS.ByteString -> BS.ByteString |
| 164 | +bsRemoveStarting needle haystack = case BS.breakSubstring needle haystack of |
| 165 | + (h, _) -> h |
0 commit comments