diff options
Diffstat (limited to 'src/HaskellCodeExplorer/Types.hs')
| -rw-r--r-- | src/HaskellCodeExplorer/Types.hs | 80 |
1 files changed, 37 insertions, 43 deletions
diff --git a/src/HaskellCodeExplorer/Types.hs b/src/HaskellCodeExplorer/Types.hs index 4c3d5c7..aac890b 100644 --- a/src/HaskellCodeExplorer/Types.hs +++ b/src/HaskellCodeExplorer/Types.hs @@ -94,8 +94,7 @@ packageIdToText (PackageId name version) = T.concat [name, "-", T.pack $ showVersion version] packageName :: PackageInfo a -> T.Text -packageName = - (name :: (PackageId -> T.Text)) . (id :: PackageInfo a -> PackageId) +packageName (PackageInfo { id = PackageId name _ }) = name data IdentifierSrcSpan = IdentifierSrcSpan { modulePath :: HaskellModulePath @@ -324,18 +323,14 @@ newtype ExternalIdentifierInfo = ExternalIdentifierInfo } deriving (Eq, Show, Generic, Data) instance Ord ExternalIdentifierInfo where - compare (ExternalIdentifierInfo i1) (ExternalIdentifierInfo i2) = - case - compare (T.length . demangledOccName $ i1) - (T.length . demangledOccName $ i2) - of + compare (ExternalIdentifierInfo (IdentifierInfo { demangledOccName = d1, internalId = i1 })) (ExternalIdentifierInfo (IdentifierInfo { demangledOccName = d2, internalId = i2 })) + = case compare (T.length d1) (T.length d2) of + GT -> GT + LT -> LT + EQ -> case compare d1 d2 of GT -> GT LT -> LT - EQ -> case compare (demangledOccName i1) (demangledOccName i2) of - GT -> GT - LT -> LT - EQ -> compare (internalId (i1 :: IdentifierInfo)) - (internalId (i2 :: IdentifierInfo)) + EQ -> compare i1 i2 data ExpressionInfo = ExpressionInfo { description :: T.Text @@ -688,39 +683,38 @@ lineToHtml lineNumber tokens = Html.tr $ do Html.! Attr.id (Html.textValue . T.append "LC" . T.pack $ show lineNumber) $ mapM_ (\(content, (start, end), mbIdOcc) -> - let addPositionAttrs :: Html.Html -> Html.Html - addPositionAttrs htmlElement = - htmlElement + let + addPositionAttrs :: Html.Html -> Html.Html + addPositionAttrs htmlElement = + htmlElement + Html.! Html.dataAttribute + "start" + (Html.textValue $ T.pack . show $ start) + Html.! Html.dataAttribute + "end" + (Html.textValue $ T.pack . show $ end) + in + case mbIdOcc of + Just (IdentifierOccurrence {..}) -> + addPositionAttrs + $ Html.span + Html.! Attr.class_ "identifier" + Html.! Attr.id + ( Html.textValue + . maybe "" getInternalId + $ internalIdFromRenamedSource + ) Html.! Html.dataAttribute - "start" - (Html.textValue $ T.pack . show $ start) + "occurrence" + ( Html.textValue + $ occurrenceLocationToText lineNumber start end + ) Html.! Html.dataAttribute - "end" - (Html.textValue $ T.pack . show $ end) - in case mbIdOcc of - Just idOcc -> - addPositionAttrs - $ Html.span - Html.! Attr.class_ "identifier" - Html.! Attr.id - ( Html.textValue - . maybe "" getInternalId - . internalIdFromRenamedSource - $ idOcc - ) - Html.! Html.dataAttribute - "occurrence" - (Html.textValue - $ occurrenceLocationToText lineNumber start end - ) - Html.! Html.dataAttribute - "identifier" - ( Html.textValue - $ maybe "" getInternalId - $ internalId (idOcc :: IdentifierOccurrence) - ) - $ Html.toHtml content - Nothing -> addPositionAttrs . Html.span . Html.toHtml $ content + "identifier" + (Html.textValue $ maybe "" getInternalId $ internalId + ) + $ Html.toHtml content + Nothing -> addPositionAttrs . Html.span . Html.toHtml $ content ) tokens |