diff options
author | Ćukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-31 18:24:40 +0200 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-08-21 18:22:33 +0100 |
commit | 96a118be9d02cc433f0982ca728e5c80a2c4c8af (patch) | |
tree | 3e28afea152a70f356752b3b58f17fbda01cd4c6 /haddock-api | |
parent | 0158692153c342eb84879338aeb99a6bb0221889 (diff) |
Make section identifier of instance details more GHC-independent.
Diffstat (limited to 'haddock-api')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 35e5c5f6..c30d0e62 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -39,7 +39,6 @@ import Text.XHtml hiding ( name, title, p, quote ) import GHC import GHC.Exts -import Unique import Name import BooleanFormula @@ -609,8 +608,8 @@ instanceId :: InstOrigin -> Int -> InstHead DocName -> String instanceId orgin no ihd = concat [ qual orgin , ":" ++ (occNameString . getOccName . ihdClsName) ihd - , "-" ++ show (instHeadId ihd) - , "-" ++ show no + , ":" ++ show (instHeadId ihd) + , ":" ++ show no ] where qual OriginClass = "ic" @@ -626,16 +625,27 @@ instanceId orgin no ihd = concat -- refactoring, for now we just generate naive hash for given instance. -- -- Hashing is very, very trivial and turns a list of 'DocName' to 'Int'. Idea --- for such simple hash function is stolen from +-- for such simple hash function (djb2) is stolen from -- <http://stackoverflow.com/questions/9262879/create-a-unique-integer-for-each-string here>. +-- +-- Hashing is performed on string representation of `Name`. Why string instead +-- of 'Unique' of that 'Name'? That would be much faster and nicer, yes. +-- However, 'Unique' is not very deterministic, so running it on different +-- configurations would yield different HTML documents. This is not very bad, +-- as nobody cares about these identifiers but it would require us to strip +-- section anchors in testing framework and that is not only inconvenient but +-- also makes testing less viable. And it is only temporary solution so we can +-- live with it. instHeadId :: InstHead DocName -> Int instHeadId (InstHead { .. }) = djb2 . map key $ [ihdClsName] ++ names ihdTypes ++ names ihdKinds where names = everything (++) $ maybeToList . (cast :: forall a. Data a => a -> Maybe DocName) - djb2 = foldl (\h c -> h * 33 `xor` c) 5381 - key = getKey . nameUnique . getName + key = djb2 . occNameString . nameOccName . getName + + djb2 :: Enum a => [a] -> Int + djb2 = foldl (\h c -> h * 33 `xor` fromEnum c) 5381 ------------------------------------------------------------------------------- |