module Language.PureScript.Docs.Tags
  ( tags
  , dumpCtags
  , dumpEtags
  ) where

import Prelude

import           Control.Arrow (first)
import           Data.List (sort)
import           Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Language.PureScript.AST (SourceSpan, sourcePosLine, spanStart)
import Language.PureScript.Docs.Types

tags :: Module -> [(String, Int)]
tags :: Module -> [(String, Int)]
tags = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
T.unpack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [(Text, Int)]
dtags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Declaration]
modDeclarations
  where
    dtags :: Declaration -> [(T.Text, Int)]
    dtags :: Declaration -> [(Text, Int)]
dtags Declaration
decl = case Declaration -> Maybe SourceSpan
declSourceSpan Declaration
decl of
      Just SourceSpan
ss -> (Declaration -> Text
declTitle Declaration
decl, SourceSpan -> Int
pos SourceSpan
ss)forall a. a -> [a] -> [a]
:forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ChildDeclaration -> Maybe (Text, Int)
subtag (Declaration -> [ChildDeclaration]
declChildren Declaration
decl)
      Maybe SourceSpan
Nothing -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ChildDeclaration -> Maybe (Text, Int)
subtag forall a b. (a -> b) -> a -> b
$ Declaration -> [ChildDeclaration]
declChildren Declaration
decl

    subtag :: ChildDeclaration -> Maybe (T.Text, Int)
    subtag :: ChildDeclaration -> Maybe (Text, Int)
subtag ChildDeclaration
cdecl = case ChildDeclaration -> Maybe SourceSpan
cdeclSourceSpan ChildDeclaration
cdecl of
      Just SourceSpan
ss -> forall a. a -> Maybe a
Just (ChildDeclaration -> Text
cdeclTitle ChildDeclaration
cdecl, SourceSpan -> Int
pos SourceSpan
ss)
      Maybe SourceSpan
Nothing -> forall a. Maybe a
Nothing

    pos :: SourceSpan -> Int
    pos :: SourceSpan -> Int
pos = SourcePos -> Int
sourcePosLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SourcePos
spanStart

-- etags files appear to be sorted on module file name:
-- from emacs source, `emacs/lib-src/etags.c`:
-- "In etags mode, sort by file name."
dumpEtags :: [(String, Module)] -> [String]
dumpEtags :: [(String, Module)] -> [String]
dumpEtags = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, Module) -> [String]
renderModEtags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort

renderModEtags :: (String, Module) -> [String]
renderModEtags :: (String, Module) -> [String]
renderModEtags (String
path, Module
mdl) = [String
"\x0c", String
path forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
tagsLen] forall a. [a] -> [a] -> [a]
++ [String]
tagLines
  where tagsLen :: Int
tagsLen = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
tagLines
        tagLines :: [String]
tagLines = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (String, a) -> String
tagLine forall a b. (a -> b) -> a -> b
$ Module -> [(String, Int)]
tags Module
mdl
        tagLine :: (String, a) -> String
tagLine (String
name, a
line) = String
"\x7f" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"\x01" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
line forall a. [a] -> [a] -> [a]
++ String
","

-- ctags files are required to be sorted: http://ctags.sourceforge.net/FORMAT
-- "The tags file is sorted on {tagname}.  This allows for a binary search in
--  the file."
dumpCtags :: [(String, Module)] -> [String]
dumpCtags :: [(String, Module)] -> [String]
dumpCtags = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, Module) -> [String]
renderModCtags

renderModCtags :: (String, Module) -> [String]
renderModCtags :: (String, Module) -> [String]
renderModCtags (String
path, Module
mdl) = forall a. Ord a => [a] -> [a]
sort [String]
tagLines
  where tagLines :: [String]
tagLines = forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
tagLine forall a b. (a -> b) -> a -> b
$ Module -> [(String, Int)]
tags Module
mdl
        tagLine :: (String, Int) -> String
tagLine (String
name, Int
line) = String
name forall a. [a] -> [a] -> [a]
++ String
"\t" forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
"\t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
line