<commit_before>{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Outline where

import           SourceSpan

import           GHC

import           Data.Aeson.TH
import           Data.Maybe
import           Data.Text (Text)

import           Paths_services_haskell

type Icon = FilePath
data Outline = Outline
    { description :: Text
    , identifier :: SourceSpan
    , icon :: Icon
    , children :: [Outline]
    } deriving Show
$(deriveJSON defaultOptions ''Outline)

data OutlineIcons = OutlineIcons
                  { klass   :: Icon
                  , modul   :: Icon
                  , private :: Icon
                  , public  :: Icon
                  , typ     :: Icon
                  }

getOutlineIcons :: IO OutlineIcons
getOutlineIcons = OutlineIcons
                  <$> getDataFileName "assets/class.png"
                  <*> getDataFileName "assets/module.png"
                  <*> getDataFileName "assets/private.png"
                  <*> getDataFileName "assets/public.png"
                  <*> getDataFileName "assets/type.png"

encodeOutline :: Document -> OutlineIcons -> ParsedModule -> Outline
encodeOutline doc icons pm =
  let md = unLoc $ pm_parsed_source pm
      maybeModName = hsmodName md
  in Outline
      { description = "compilation-unit"
      , identifier = SourceSpan 0 0
      , icon = ""
      , children = [
         Outline
           { description = "module"
           , identifier = fromMaybe (SourceSpan 0 0) $ lineColumnToOffsetLength doc =<< getLoc <$> maybeModName
           , icon = modul icons
           , children = mapMaybe outlineDecl (hsmodDecls md)
           }
        ]
      }
  where

    outlineDecl :: LHsDecl RdrName -> Maybe Outline
    outlineDecl ldecl = do
      (desc,ico) <- case unLoc ldecl of
        TyClD (FamDecl _) -> Just ("type-family", typ icons)
        TyClD (SynDecl {}) -> Just ("type-alias", typ icons)
        TyClD (DataDecl {}) -> Just ("data-declaration", typ icons)
        TyClD (ClassDecl {}) -> Just ("class-declarartion", typ icons)
        SigD (TypeSig {}) -> Just ("type-signature", public icons)
        _ -> Nothing
      return Outline
        { description = desc
        , identifier = fromJust $ lineColumnToOffsetLength doc $ getLoc ldecl
        , icon = ico
        , children = []
        }
<commit_msg>use URLs as Outline image source<commit_after>{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Outline where

import           SourceSpan

import           GHC

import           Data.Aeson.TH
import           Data.Maybe
import           Data.Text (Text)

import           Paths_services_haskell

type Icon = FilePath
data Outline = Outline
    { description :: Text
    , identifier :: SourceSpan
    , icon :: Icon
    , children :: [Outline]
    } deriving Show
$(deriveJSON defaultOptions ''Outline)

data OutlineIcons = OutlineIcons
                  { klass   :: Icon
                  , modul   :: Icon
                  , private :: Icon
                  , public  :: Icon
                  , typ     :: Icon
                  }

getOutlineIcons :: IO OutlineIcons
getOutlineIcons = OutlineIcons
                  <$> getResource "assets/class.png"
                  <*> getResource "assets/module.png"
                  <*> getResource "assets/private.png"
                  <*> getResource "assets/public.png"
                  <*> getResource "assets/type.png"
  where
    getResource name = do
      path <- getDataFileName name
      return $ "file://" ++ path

encodeOutline :: Document -> OutlineIcons -> ParsedModule -> Outline
encodeOutline doc icons pm =
  let md = unLoc $ pm_parsed_source pm
      maybeModName = hsmodName md
  in Outline
      { description = "compilation-unit"
      , identifier = SourceSpan 0 0
      , icon = ""
      , children = [
         Outline
           { description = "module"
           , identifier = fromMaybe (SourceSpan 0 0) $ lineColumnToOffsetLength doc =<< getLoc <$> maybeModName
           , icon = modul icons
           , children = mapMaybe outlineDecl (hsmodDecls md)
           }
        ]
      }
  where

    outlineDecl :: LHsDecl RdrName -> Maybe Outline
    outlineDecl ldecl = do
      (desc,ico) <- case unLoc ldecl of
        TyClD FamDecl{} -> Just ("type-family", typ icons)
        TyClD SynDecl{} -> Just ("type-alias", typ icons)
        TyClD DataDecl{} -> Just ("data-declaration", typ icons)
        TyClD ClassDecl{} -> Just ("class-declarartion", typ icons)
        SigD TypeSig{} -> Just ("type-signature", public icons)
        _ -> Nothing
      return Outline
        { description = desc
        , identifier = fromJust $ lineColumnToOffsetLength doc $ getLoc ldecl
        , icon = ico
        , children = []
        }

{'fraction_non_alphanumeric': 0.09808760024676126, 'fraction_numerical': 0.001645075056549455, 'mean_word_length': 1.8849347568208779, 'pattern_counts': {'":': 0, '<': 22, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4389768', 'n_tokens_mistral': 1401, 'n_tokens_neox': 1345, 'n_words': 365}