Initial commit

1 files changed, 880 insertions, 0 deletions

diff --git a/src/HaskellCodeExplorer/Types.hs b/src/HaskellCodeExplorer/Types.hs
new file mode 100644
index 0000000..9e3667d
--- /dev/null
+++ b/src/HaskellCodeExplorer/Types.hs
@@ -0,0 +1,880 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module HaskellCodeExplorer.Types where
+
+import Control.DeepSeq (NFData)
+import qualified Data.Aeson as A
+import Data.Aeson.Types (Options, defaultOptions, omitNothingFields)
+import Data.Generics
+  ( Constr
+  , Data(..)
+  , DataType
+  , Fixity(..)
+  , constrIndex
+  , gcast2
+  , mkConstr
+  , mkDataType
+  )
+import qualified Data.HashMap.Strict as HM
+import Data.Hashable (Hashable)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntervalMap.Strict as IVM
+import qualified Data.List as L
+import Data.Maybe (fromMaybe, isJust)
+import Data.Serialize (Get, Serialize(..))
+import qualified Data.Set as S      
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Text.Lazy (toStrict)
+import qualified Data.Vector as V
+import Data.Version (Version(..),showVersion)
+import Documentation.Haddock.Types
+  ( DocH(..)
+  , Example(..)
+  , Header(..)
+  , Hyperlink(..)
+  , Picture(..)
+  )
+import GHC.Generics (Generic)
+import Prelude hiding (id)
+import Text.Blaze.Html.Renderer.Text (renderHtml)
+import qualified Text.Blaze.Html5 as Html
+import qualified Text.Blaze.Html5.Attributes as Attr
+
+--------------------------------------------------------------------------------
+-- Package info
+--------------------------------------------------------------------------------
+
+data PackageInfo modInfo = PackageInfo
+  { id :: PackageId
+  , moduleMap :: HM.HashMap HaskellModulePath modInfo
+  , moduleNameMap :: HM.HashMap HaskellModuleName (HM.HashMap ComponentId HaskellModulePath)
+  , directoryTree :: DirTree
+  , externalIdInfoMap :: Trie Char ExternalIdentifierInfo
+  -- ^ All external identifiers defined in the package
+  , externalIdOccMap :: HM.HashMap ExternalId (S.Set IdentifierSrcSpan)
+  -- ^ All occurrences of each external identifier in the package
+  } deriving (Show, Eq, Generic, Data)
+
+data PackageId = PackageId
+  { name :: T.Text
+  , version :: Data.Version.Version
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+packageIdToText :: PackageId -> T.Text
+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)
+
+data IdentifierSrcSpan = IdentifierSrcSpan
+  { modulePath :: HaskellModulePath
+  , line :: Int
+  , startColumn :: Int
+  , endColumn :: Int
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data DirTree
+  = Dir { name :: FilePath
+        , contents :: [DirTree] }
+  | File { name :: FilePath
+         , path :: FilePath
+         , isHaskellModule :: Bool }
+  deriving (Show, Eq, Generic, Data)
+
+newtype ComponentId = ComponentId
+  { getComponentId :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data, Hashable)
+
+data ComponentType
+  = Setup
+  | Lib
+  | SubLib T.Text
+  | FLib T.Text
+  | Exe T.Text
+  | Test T.Text
+  | Bench T.Text
+  deriving (Show, Eq, Generic, Data)
+
+isLibrary :: ComponentType -> Bool
+isLibrary Lib = True
+isLibrary (SubLib _) = True
+isLibrary (FLib _) = True
+isLibrary _ = False
+
+packageInfoBinaryFileName :: FilePath
+packageInfoBinaryFileName = "packageInfo"
+
+packageInfoJsonFileName :: FilePath
+packageInfoJsonFileName = "packageInfo.json"
+
+defaultOutputDirectoryName :: FilePath
+defaultOutputDirectoryName = ".haskell-code-explorer"
+
+--------------------------------------------------------------------------------
+-- A simple Trie implementation
+--------------------------------------------------------------------------------
+
+data Trie k v = Trie
+  { values :: S.Set v
+  , children :: HM.HashMap k (Trie k v)
+  } deriving (Show, Eq, Generic, Data)
+
+emptyTrie :: Trie k v
+emptyTrie = Trie S.empty HM.empty
+
+insertToTrie ::
+     (Hashable k, Eq k, Ord v)
+  => (v -> S.Set v -> S.Set v)
+  -> [k]
+  -> v
+  -> Trie k v
+  -> Trie k v
+insertToTrie f [] v (Trie vals children) = Trie (f v vals) children
+insertToTrie f word@(first:rest) val (Trie vals children) =
+  case HM.lookup first children of
+    Just trie ->
+      Trie vals (HM.insert first (insertToTrie f rest val trie) children)
+    Nothing ->
+      insertToTrie f word val (Trie vals (HM.insert first emptyTrie children))
+
+match :: (Hashable k, Eq k, Ord v) => [k] -> Trie k v -> S.Set v
+match (first:rest) (Trie _ children) =
+  maybe S.empty (match rest) (HM.lookup first children)
+match [] (Trie val children) =
+  S.union val $
+  S.unions
+    [S.union v $ match [] trie | (_, trie@(Trie v _)) <- HM.toList children]
+
+--------------------------------------------------------------------------------
+-- Module info
+--------------------------------------------------------------------------------
+
+data ModuleInfo = ModuleInfo
+  { id :: HaskellModulePath
+  , name :: HaskellModuleName
+  , source :: V.Vector T.Text
+    -- ^ Source code of the module
+  , transformation :: SourceCodeTransformation
+  , exprInfoMap :: ExpressionInfoMap
+    -- ^ Type of each expression in the module
+  , idOccMap :: IdentifierOccurrenceMap
+    -- ^ All occurrences of each identifier in the module
+  , idInfoMap :: IdentifierInfoMap
+    -- ^ Information about each identifier in the module
+  , declarations :: [Declaration]
+  , definitionSiteMap :: DefinitionSiteMap
+    -- ^ Definition site of each top-level value, type, and type class instance    
+  , externalIds :: [ExternalIdentifierInfo]
+  } deriving (Show, Eq, Generic, Data)
+
+type ExpressionInfoMap = IVM.IntervalMap (Int, Int) ExpressionInfo
+type IdentifierOccurrenceMap = IM.IntMap [((Int, Int), IdentifierOccurrence)]
+type IdentifierInfoMap = HM.HashMap InternalId IdentifierInfo
+
+data DefinitionSiteMap = DefinitionSiteMap
+  { values :: HM.HashMap OccName DefinitionSite
+  , types :: HM.HashMap OccName DefinitionSite
+  , instances :: HM.HashMap T.Text DefinitionSite
+  } deriving (Show, Eq, Generic, Data)
+
+data DefinitionSite = DefinitionSite
+  { location :: LocationInfo
+  , documentation :: Maybe HTML
+  } deriving (Show, Eq, Generic, Data)
+
+type HTML = T.Text
+
+newtype OccName = OccName
+  { getOccName :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data, Hashable)
+
+-- | 'CompactModuleInfo' contains a subset of fields of 'ModuleInfo'.
+data CompactModuleInfo = CompactModuleInfo
+  { id :: HaskellModulePath
+  , name :: HaskellModuleName
+  , exprInfoMap :: ExpressionInfoMap
+  , definitionSiteMap :: DefinitionSiteMap
+  , source :: V.Vector T.Text
+  } deriving (Show, Eq, Generic, Data)
+
+haskellPreprocessorExtensions :: [FilePath]
+haskellPreprocessorExtensions =
+  [".hsc", ".chs", ".cpphs", ".gc", ".x", ".y", ".ly"]
+
+toCompactPackageInfo :: PackageInfo ModuleInfo -> PackageInfo CompactModuleInfo
+toCompactPackageInfo PackageInfo {..} =
+  PackageInfo
+    { id = id    
+    , moduleMap = HM.map toCompactModuleInfo moduleMap
+    , moduleNameMap = moduleNameMap
+    , directoryTree = directoryTree
+    , externalIdOccMap = externalIdOccMap
+    , externalIdInfoMap = externalIdInfoMap
+    }
+
+toCompactModuleInfo :: ModuleInfo -> CompactModuleInfo
+toCompactModuleInfo ModuleInfo {..} =
+  CompactModuleInfo
+    { id = id
+    , name = name
+    , exprInfoMap = exprInfoMap
+    , definitionSiteMap = definitionSiteMap
+    , source = source
+    }
+
+newtype HaskellModuleName = HaskellModuleName
+  { getHaskellModuleName :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data)
+
+newtype HaskellModulePath = HaskellModulePath
+  { getHaskellModulePath :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data)
+
+newtype HaskellFilePath = HaskellFilePath
+  { getHaskellFilePath :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data)
+
+-- | Haskell identifier (value or type)
+data IdentifierInfo = IdentifierInfo
+  { sort :: NameSort
+  , occName :: OccName
+  , demangledOccName :: T.Text
+  , nameSpace :: NameSpace
+  , locationInfo :: LocationInfo
+  , idType :: Type
+  , details :: Maybe IdDetails
+  , doc :: Maybe HTML
+  , internalId :: InternalId
+  , externalId :: Maybe ExternalId
+  , isExported :: Bool
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data NameSort
+  = External
+  | Internal
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data NameSpace
+  = VarName
+  | DataName
+  | TvName
+  | TcClsName
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data IdDetails
+  = VanillaId
+  | RecSelId
+  | RecSelIdNaughty
+  | DataConWorkId
+  | DataConWrapId
+  | ClassOpId
+  | PrimOpId
+  | FCallId
+  | TickBoxOpId
+  | DFunId
+  | CoVarId
+  | JoinId
+  deriving (Show, Eq, Ord, Generic, Data)
+
+-- | Each Haskell identifier has an 'InternalId' that is unique within a single module
+newtype InternalId = InternalId
+  { getInternalId :: T.Text
+  } deriving (Show, Eq, Ord, Generic, Data, Hashable, A.ToJSONKey)
+
+newtype ExternalId = ExternalId
+  { getExternalId :: T.Text
+  } deriving (Show, Eq, Ord, Generic, Data, Hashable, A.ToJSONKey)
+
+newtype ExternalIdentifierInfo = ExternalIdentifierInfo
+  { getIdentifierInfo :: IdentifierInfo
+  } 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
+      GT -> GT
+      LT -> LT
+      EQ ->
+        case compare (demangledOccName i1) (demangledOccName i2) of
+          GT -> GT
+          LT -> LT
+          EQ ->            
+            compare
+              (internalId (i1 :: IdentifierInfo))
+              (internalId (i2 :: IdentifierInfo))
+        
+data ExpressionInfo = ExpressionInfo
+  { description :: T.Text
+  , exprType :: Maybe Type
+  } deriving (Show, Eq, Generic, Data)
+
+-- | Occurrence of an identifier in a source code
+data IdentifierOccurrence = IdentifierOccurrence
+  { internalId :: Maybe InternalId
+  , internalIdFromRenamedSource :: Maybe InternalId
+  , isBinder :: Bool
+  , instanceResolution :: Maybe InstanceResolution
+  , idOccType :: Maybe Type
+  -- ^ Instantiated type of an identifier
+  , typeArguments :: Maybe [Type]
+  , description :: T.Text
+  , sort :: IdentifierOccurrenceSort
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data IdentifierOccurrenceSort
+  = ValueId
+  | TypeId
+  | ModuleId LocationInfo
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data Type = Type
+  { components :: [TypeComponent]
+  , componentsExpanded :: Maybe [TypeComponent]
+  -- ^ Components of a type with all type synonyms expanded
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data TypeComponent
+  = Text T.Text
+  | TyCon { internalId :: InternalId
+          , name :: T.Text }
+  deriving (Show, Eq, Ord, Generic, Data)
+
+-- | Tree of instances
+data InstanceResolution =
+  Instance
+  { name :: T.Text
+  -- ^ Type of an instance, e.g., "instance Show a => ClassName a"
+  , instanceType :: Type
+  , types :: [Type]
+  -- ^ Types at which type variables of a class are instantiated
+  , location :: LocationInfo
+  , instances :: [InstanceResolution]  
+  }
+  | Stop
+  deriving (Show,Eq,Ord,Generic,Data)
+
+data SourceCodeTransformation = SourceCodeTransformation
+  { totalLines :: Int
+  , filePath :: HaskellModulePath
+  , linePragmas :: S.Set LinePragma
+  , fileIndex :: HM.HashMap HaskellFilePath (S.Set FileLocation)
+  -- ^ Map from an original filename to its locations in a preprocessed source code
+  } deriving (Show, Eq, Generic, Data)
+
+-- | Location of a file included by a preprocessor
+data FileLocation = FileLocation
+  { lineStart :: Int
+  , lineEnd :: Int
+  , offset :: Int
+  -- ^ (line number in a preprocessed file) - (line number in an original file) + 1
+  } deriving (Show, Eq, Generic, Data)
+
+-- | Line pragma inserted by a preprocessor
+data LinePragma = LinePragma
+  { filePath :: HaskellFilePath
+  , lineNumberPreprocessed :: Int
+  , lineNumberOriginal :: Int
+  } deriving (Show, Eq, Generic, Data)
+
+fromOriginalLineNumber ::
+     SourceCodeTransformation -> (HaskellFilePath, Int) -> Either T.Text Int
+fromOriginalLineNumber SourceCodeTransformation {linePragmas = pragmas} (_originalFileName, originalLineNumber)
+  | S.null pragmas = Right originalLineNumber
+fromOriginalLineNumber SourceCodeTransformation {fileIndex = index} (originalFileName, originalLineNumber) =
+  case HM.lookup originalFileName index of
+    Just set ->
+      -- lookupGE finds smallest element greater or equal to the given one
+      case S.lookupGE (FileLocation 1 originalLineNumber 1) set of
+        Just FileLocation {..} -> Right $ originalLineNumber + offset
+        Nothing ->
+          Left $
+          T.concat
+            [ "Cannot find "
+            , T.pack . show $ (originalFileName, originalLineNumber)
+            , " in "
+            , T.pack $ show index
+            ]
+    Nothing ->
+      Left $
+      T.concat
+        [ "Cannot find file "
+        , T.pack . show $ originalFileName
+        , " in "
+        , T.pack $ show index
+        ]
+        
+data Declaration = Declaration
+  { sort :: DeclarationSort
+  , name :: T.Text
+  , declType :: Maybe Type
+  , isExported :: Bool
+  , lineNumber :: Int
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data DeclarationSort
+  = TyClD
+  | InstD
+  | ValD
+  | ForD
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data LocationInfo
+  = ExactLocation { packageId :: PackageId
+                  , modulePath :: HaskellModulePath
+                  , moduleName :: HaskellModuleName
+                  , startLine :: Int
+                  , endLine :: Int
+                  , startColumn :: Int
+                  , endColumn :: Int }
+  | ApproximateLocation { packageId :: PackageId
+                        , moduleName :: HaskellModuleName
+                        , entity :: LocatableEntity
+                        , name :: T.Text
+                        , haddockAnchorId :: Maybe T.Text
+                        , componentId :: ComponentId }
+  | UnknownLocation T.Text
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data LocatableEntity
+  = Typ
+  | Val
+  | Inst
+  | Mod
+  deriving (Show, Eq, Ord, Generic, Data)
+
+--------------------------------------------------------------------------------
+-- Instances
+--------------------------------------------------------------------------------
+
+deriving instance (Data k) => Data (IVM.Interval k)
+
+instance (Data k, Data v, Eq k, Ord k, Data (IVM.Interval k)) =>
+         Data (IVM.IntervalMap k v) where
+  gfoldl f z m = z IVM.fromList `f` IVM.toList m
+  toConstr _ = fromListConstr
+  gunfold k z c =
+    case constrIndex c of
+      1 -> k (z IVM.fromList)
+      _ -> error "gunfold"
+  dataTypeOf _ = intervalMapDataType
+  dataCast2 = gcast2
+
+fromListConstr :: Constr
+fromListConstr = mkConstr intervalMapDataType "fromList" [] Prefix
+
+intervalMapDataType :: DataType
+intervalMapDataType = mkDataType "Data.IntervalMap" [fromListConstr]
+
+deriving instance Generic (IVM.Interval k)
+
+instance Hashable HaskellModuleName
+instance Serialize HaskellModuleName
+instance Hashable HaskellModulePath
+instance Serialize HaskellModulePath
+instance Hashable HaskellFilePath
+instance Serialize HaskellFilePath
+instance (Serialize k, Serialize v, Ord k) =>
+         Serialize (IVM.IntervalMap k v) where
+  put = put . IVM.toAscList
+  get = IVM.fromAscList <$> Data.Serialize.get
+instance Ord LinePragma where
+  compare p1 p2 =
+    compare
+      (lineNumberPreprocessed (p1 :: LinePragma))
+      (lineNumberPreprocessed (p2 :: LinePragma))
+instance Ord FileLocation where
+  compare l1 l2 = compare (lineEnd l1) (lineEnd l2)
+instance Serialize LinePragma
+instance Serialize FileLocation
+instance Serialize SourceCodeTransformation
+instance Serialize IdentifierInfo
+instance Serialize InternalId
+instance Serialize ExternalId
+instance Serialize ExternalIdentifierInfo where
+  put (ExternalIdentifierInfo info) = put info
+  get = ExternalIdentifierInfo <$>(get :: Get IdentifierInfo)
+instance Serialize InstanceResolution
+instance Serialize OccName
+instance Serialize IdDetails
+instance Serialize NameSpace
+instance Serialize DefinitionSiteMap
+instance Serialize DefinitionSite
+instance Serialize Declaration
+instance Serialize NameSort
+instance Serialize DeclarationSort
+instance Serialize PackageId
+instance Serialize Data.Version.Version
+instance Serialize (PackageInfo ModuleInfo)
+instance Serialize (PackageInfo CompactModuleInfo)
+instance Serialize IdentifierSrcSpan
+instance Serialize DirTree
+instance Serialize ComponentId
+instance Serialize ComponentType
+instance Serialize T.Text where
+  put = put . encodeUtf8
+  get = decodeUtf8 <$> Data.Serialize.get
+instance (Serialize k, Serialize v, Eq k,Hashable k) => Serialize (HM.HashMap k v) where
+  put = put . HM.toList
+  get = HM.fromList <$> get
+instance Serialize ModuleInfo
+instance Serialize CompactModuleInfo
+instance (Serialize k) => Serialize (IVM.Interval k)
+instance Serialize LocationInfo
+instance Serialize IdentifierOccurrence
+instance Serialize IdentifierOccurrenceSort
+instance Serialize TypeComponent
+instance (Serialize a) => Serialize (V.Vector a) where
+  put = put . V.toList
+  get = V.fromList <$> get
+instance Serialize Type
+instance Serialize ExpressionInfo
+instance Serialize LocatableEntity
+instance (Serialize k,Ord k,Serialize v,Ord v,Hashable k) => Serialize (Trie k v)
+instance NFData HaskellModuleName
+instance NFData HaskellModulePath
+instance NFData HaskellFilePath
+instance NFData LinePragma
+instance NFData FileLocation
+instance NFData SourceCodeTransformation
+instance NFData IdentifierInfo
+instance NFData InternalId
+instance NFData ExternalId
+instance NFData ExternalIdentifierInfo 
+instance NFData InstanceResolution
+instance NFData IdDetails
+instance NFData NameSpace
+instance NFData OccName
+instance NFData DefinitionSiteMap
+instance NFData DefinitionSite
+instance NFData Declaration
+instance NFData NameSort
+instance NFData DeclarationSort
+instance NFData PackageId
+instance NFData (PackageInfo ModuleInfo)
+instance NFData (PackageInfo CompactModuleInfo)
+instance NFData IdentifierSrcSpan
+instance NFData DirTree
+instance NFData ComponentId
+instance NFData ComponentType
+instance NFData ModuleInfo
+instance NFData CompactModuleInfo
+instance NFData LocationInfo
+instance NFData IdentifierOccurrence
+instance NFData IdentifierOccurrenceSort
+instance NFData TypeComponent
+instance NFData Type
+instance NFData ExpressionInfo
+instance NFData LocatableEntity
+instance (NFData k, Ord k, NFData v, Ord v, Hashable k) =>
+         NFData (Trie k v)
+
+omitNothingOptions :: Options
+omitNothingOptions = defaultOptions {omitNothingFields = True}
+
+instance A.ToJSON (PackageInfo a) where
+  toJSON PackageInfo {..} =
+    A.object
+      [ ("id", A.toJSON $ packageIdToText id)
+      , ("directoryTree", A.toJSON directoryTree)
+      , ("modules", A.toJSON . HM.map (const ()) $ moduleMap)
+      ]
+
+instance A.ToJSON ModuleInfo where
+  toJSON ModuleInfo {..} =
+    let sourceCodeLines = zip [1 ..] $ V.toList source
+        tokenizedLines =
+          L.map
+            (\(lineNumber, lineText) ->
+               case IM.lookup lineNumber idOccMap of
+                 Just identifiers -> (lineNumber, tokenize lineText identifiers)
+                 Nothing ->
+                   ( lineNumber
+                   , [(lineText, (1, T.length lineText + 1), Nothing)]))
+            sourceCodeLines
+        html =
+          Html.table Html.! Attr.class_ "source-code" $
+          Html.tbody $ mapM_ (uncurry lineToHtml) tokenizedLines
+     in A.object
+          [ ("id", A.toJSON id)
+          , ("name", A.toJSON name)
+          , ("sourceCodeHtml", A.toJSON . renderHtml $ html)
+          , ("identifiers", A.toJSON idInfoMap)
+          , ("occurrences", A.toJSON $ idOccurrencesHashMap idOccMap)
+          , ("declarations", A.toJSON declarations)
+          ]
+          
+idOccurrencesHashMap ::
+     IM.IntMap [((Int, Int), IdentifierOccurrence)]
+  -> HM.HashMap T.Text IdentifierOccurrence
+idOccurrencesHashMap =
+  HM.fromList .
+  concatMap
+    (\(lineNum, occs) ->
+       L.map
+         (\((startCol, endCol), occ) ->
+            (occurrenceLocationToText lineNum startCol endCol, occ))
+         occs) .
+  IM.toList 
+
+idOccurrenceList ::
+     IM.IntMap [((Int, Int), IdentifierOccurrence)]
+  -> HM.HashMap T.Text IdentifierOccurrence
+idOccurrenceList =
+  HM.fromList .
+  concatMap
+    (\(lineNum, occs) ->
+       L.map
+         (\((startCol, endCol), occ) ->
+            (occurrenceLocationToText lineNum startCol endCol, occ))
+         occs) .
+  IM.toList 
+
+occurrenceLocationToText :: Int -> Int -> Int -> T.Text
+occurrenceLocationToText lineNum startCol endCol =
+  T.concat
+    [ T.pack . show $ lineNum
+    , "-"
+    , T.pack . show $ startCol
+    , "-"
+    , T.pack . show $ endCol
+    ]
+
+lineToHtml :: Int
+           -> [(T.Text, (Int, Int), Maybe IdentifierOccurrence)]
+           -> Html.Html
+lineToHtml lineNumber tokens =
+  Html.tr $ do
+    Html.td Html.! Attr.class_ "line-number" Html.!
+      Attr.id (Html.textValue . T.append "LN" . T.pack $ show lineNumber) $
+      Html.toHtml (T.pack $ show lineNumber)
+    Html.td Html.! Attr.class_ "line-content" Html.!
+      Html.dataAttribute "line" (Html.textValue $ T.pack . show $ lineNumber) 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 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 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)
+        tokens
+
+tokenize
+  :: forall a.
+     T.Text -- ^ Source code
+  -> [((Int, Int), a)] -- ^ Identifier locations
+                       -- The end position is defined to be the column /after/ the end of the
+                       -- span. That is, a span of (1,1)-(1,2) is one character long, and a
+                       -- span of (1,1)-(1,1) is zero characters long.                       
+  -> [(T.Text, (Int, Int), Maybe a)]
+tokenize line =
+  L.reverse .
+  (\(remainingLine, currentIndex, c) ->
+     if T.null remainingLine
+       then c
+       else (remainingLine, (currentIndex, T.length line + 1), Nothing) : c) .
+  L.foldl' split (line, 1, [])
+  where
+    split ::
+         (T.Text, Int, [(T.Text, (Int, Int), Maybe a)])
+      -> ((Int, Int), a)
+      -> (T.Text, Int, [(T.Text, (Int, Int), Maybe a)])
+    split (remainingLine, currentIndex, chunks) ((start, end), a)
+      | start == currentIndex =
+        let (chunk, remainingLine') = T.splitAt (end - start) remainingLine
+            chunks' = (chunk, (start, end), Just a) : chunks
+         in (remainingLine', end, chunks')
+      | otherwise =
+        let (chunkNoId, remainingLine') =
+              T.splitAt (start - currentIndex) remainingLine
+            (chunk, remainingLine'') = T.splitAt (end - start) remainingLine'
+         in ( remainingLine''
+            , end
+            , (chunk, (start, end), Just a) :
+              (chunkNoId, (currentIndex, start), Nothing) : chunks)
+
+docToHtml ::
+     forall mod id.
+     (mod -> Html.Html)
+  -> (id -> Html.Html)
+  -> DocH mod id
+  -> HTML
+docToHtml modToHtml idToHtml = toStrict . renderHtml . toH
+  where
+    toH :: DocH mod id -> Html.Html
+    toH (DocAppend doc1 doc2) = toH doc1 >> toH doc2
+    toH (DocParagraph doc) = Html.p $ toH doc
+    toH (DocIdentifier identifier) = Html.span $ idToHtml identifier
+    toH (DocWarning doc) = Html.div Html.! Attr.class_ "warning" $ toH doc
+    toH (DocEmphasis doc) = Html.em $ toH doc
+    toH DocEmpty = mempty
+    toH (DocBold doc) = Html.b $ toH doc
+    toH (DocMonospaced doc) =
+      Html.span Html.! Attr.class_ "source-code-font" $ toH doc
+    toH (DocUnorderedList docs) = Html.ul $ mapM_ (Html.li . toH) docs
+    toH (DocOrderedList docs) = Html.ol $ mapM_ (Html.li . toH) docs
+    toH (DocDefList docs) =
+      Html.dl $
+      mapM_ (\(doc1, doc2) -> Html.dt (toH doc1) >> Html.dd (toH doc2)) docs
+    toH (DocCodeBlock doc) = Html.div Html.! Attr.class_ "source-code" $ toH doc
+    toH (DocIdentifierUnchecked modName) = modToHtml modName
+    toH (DocModule str) = Html.span . Html.toHtml . T.pack $ str
+    toH (DocHyperlink (Hyperlink url mbTitle)) =
+      Html.a Html.! (Attr.href . Html.textValue . T.pack $ url) $
+      Html.toHtml $ fromMaybe url mbTitle
+    toH (DocPic (Picture uri mbTitle)) =
+      Html.img Html.! (Attr.src . Html.textValue . T.pack $ uri) Html.!
+      (Attr.title . Html.textValue . T.pack $ fromMaybe "" mbTitle)
+    toH (DocMathInline str) =
+      Html.span . Html.toHtml $ T.pack ("\\(" ++ str ++ "\\)")
+    toH (DocMathDisplay str) =
+      Html.div . Html.toHtml $ T.pack ("\\[" ++ str ++ "\\]")
+    toH (DocAName str) =
+      Html.a Html.! (Attr.id . Html.textValue . T.pack $ str) $ mempty
+    toH (DocProperty str) =
+      Html.div Html.! Attr.class_ "source-code" $ Html.toHtml $ T.pack str
+    toH (DocExamples examples) =
+      Html.div Html.! Attr.class_ "source-code" $
+      mapM_
+        (\(Example expr results) ->
+           let htmlPrompt = Html.span $ Html.toHtml (">>> " :: String)
+               htmlExpression = Html.span $ Html.toHtml (expr ++ "\n")
+            in htmlPrompt >> htmlExpression >>
+               mapM_ (Html.span . Html.toHtml) (unlines results))
+        examples
+    toH (DocString str) = Html.span . Html.toHtml $ T.pack str    
+    toH (DocHeader (Header level doc)) = toHeader level $ toH doc
+      where
+        toHeader 1 = Html.h1
+        toHeader 2 = Html.h2
+        toHeader 3 = Html.h3
+        toHeader 4 = Html.h4
+        toHeader 5 = Html.h5
+        toHeader _ = Html.h6
+        
+instance A.ToJSON HaskellModuleName where
+  toJSON (HaskellModuleName name) = A.String name
+instance A.ToJSON HaskellModulePath where
+  toJSON (HaskellModulePath path) = A.String path
+instance A.ToJSON HaskellFilePath where
+  toJSON (HaskellFilePath path) = A.String path  
+instance A.ToJSON LinePragma where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON FileLocation where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON IdentifierInfo where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON InternalId where
+  toJSON (InternalId text) = A.toJSON text
+instance A.ToJSON ExternalId where
+  toJSON (ExternalId text) = A.toJSON text    
+instance A.ToJSON ExternalIdentifierInfo where
+  toJSON (ExternalIdentifierInfo info) = A.toJSON info
+instance A.ToJSON InstanceResolution where
+  toJSON (Instance name typ types location instances) =
+    A.object
+      [ "name" A..= A.toJSON name
+      , "types" A..= A.toJSON types
+      , "location" A..= A.toJSON location
+      , "instanceType" A..= A.toJSON typ
+      , "instances" A..=
+        (A.Array . V.fromList . Prelude.map A.toJSON $ instances)
+      ]
+  toJSON Stop = A.Null
+instance A.ToJSON IdDetails where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON NameSpace where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON Declaration  
+instance A.ToJSON NameSort
+instance A.ToJSON OccName where
+  toJSON (OccName name) = A.String name
+instance A.ToJSON DeclarationSort
+instance A.ToJSON PackageId
+instance A.ToJSON ComponentId where
+  toJSON (ComponentId id) = A.toJSON id
+instance A.ToJSON ComponentType
+instance A.ToJSON LocationInfo where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON LocatableEntity
+instance A.ToJSON IdentifierOccurrence where
+  toJSON IdentifierOccurrence {..} =
+    A.object $
+    [("sort", A.toJSON sort)] ++
+    [("description", A.toJSON description)] ++
+    [("internalId", A.toJSON internalId) | isJust internalId] ++
+    [("isBinder", A.toJSON isBinder) | isBinder] ++
+    [("instanceResolution", A.toJSON instanceResolution) | isJust instanceResolution] ++
+    [("idOccType", A.toJSON idOccType) | isJust idOccType]
+instance A.ToJSON IdentifierOccurrenceSort
+instance A.ToJSON TypeComponent where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON Type where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON ExpressionInfo where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON DirTree    
+instance A.ToJSON DefinitionSite where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON IdentifierSrcSpan
+instance A.ToJSON (IVM.Interval (Int, Int)) where
+  toJSON (IVM.IntervalCO a b) = intervalToValue a b
+  toJSON (IVM.ClosedInterval a b) = intervalToValue a b
+  toJSON (IVM.OpenInterval a b) = intervalToValue a b
+  toJSON (IVM.IntervalOC a b) = intervalToValue a b
+
+intervalToValue :: (Int, Int) -> (Int, Int) -> A.Value
+intervalToValue (l1, c1) (l2, c2) =
+  A.object
+    [ ("start", A.object [("line", A.toJSON l1), ("column", A.toJSON c1)])
+    , ("end", A.object [("line", A.toJSON l2), ("column", A.toJSON c2)])
+    ]
+
+data SourceCodePreprocessing
+  = AfterPreprocessing
+  | BeforePreprocessing
+  deriving (Show, Eq)
+
+data Log
+  = StdOut
+  | ToFile FilePath
+  deriving (Show, Eq)