aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaskellCodeExplorer')
-rw-r--r--src/HaskellCodeExplorer/AST/TypecheckedSource.hs1
-rw-r--r--src/HaskellCodeExplorer/PackageInfo.hs16
-rw-r--r--src/HaskellCodeExplorer/Types.hs80
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