diff options
Diffstat (limited to 'src/HaskellCodeExplorer')
| -rw-r--r-- | src/HaskellCodeExplorer/AST/TypecheckedSource.hs | 1 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/PackageInfo.hs | 16 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/Types.hs | 80 |
3 files changed, 40 insertions, 57 deletions
diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs index 232d54d..3ca9194 100644 --- a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs +++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs @@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE StrictData #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module HaskellCodeExplorer.AST.TypecheckedSource ( ASTState(..) diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs index 295f1cb..8e0fbdf 100644 --- a/src/HaskellCodeExplorer/PackageInfo.hs +++ b/src/HaskellCodeExplorer/PackageInfo.hs @@ -13,21 +13,17 @@ module HaskellCodeExplorer.PackageInfo , ghcVersion ) where import Control.DeepSeq ( deepseq ) -import Control.Exception ( IOException - , SomeAsyncException +import Control.Exception ( SomeAsyncException , SomeException , fromException , throw - , try ) import Control.Monad ( foldM , unless , when ) import Control.Monad.Catch ( handle ) -import Control.Monad.Extra ( anyM - , findM - ) +import Control.Monad.Extra ( findM ) import Control.Monad.Logger ( LoggingT(..) , MonadLogger(..) , MonadLoggerIO(..) @@ -120,7 +116,6 @@ import qualified HaskellCodeExplorer.Types as HCE import Prelude hiding ( id ) import System.Directory ( canonicalizePath , doesFileExist - , findExecutable , getCurrentDirectory , getDirectoryContents , makeAbsolute @@ -136,16 +131,9 @@ import System.FilePath ( (</>) , splitDirectories , splitPath , takeBaseName - , takeDirectory , takeExtension , takeFileName ) -import System.FilePath.Find ( (==?) - , always - , fileName - , find - ) -import System.Process ( readProcess ) testCreatePkgInfo :: FilePath -> IO (HCE.PackageInfo HCE.ModuleInfo) testCreatePkgInfo pkgPath = runStdoutLoggingT 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 |