{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell    #-}
-- everyting tagfile related ..
-- this should be moved into its own library (after cleaning up most of it ..)
-- yes, this is still specific to hasktags :(
module Tags where
import           Control.Monad       (when)
import           Data.Char           (isSpace)
import           Data.Data           (Data, Typeable)
import           Data.List           (sortBy, intercalate)
import           Lens.Micro.Platform
import           System.IO           (Handle, hPutStr, hPutStrLn)

-- my words is mainly copied from Data.List.
-- difference abc::def is recognized as three words
-- `abc` is recognized as "`" "abc" "`"
mywords :: Bool -> String -> [String]
mywords :: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
s =  case [Char]
rest of
                        Char
')':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
")") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        [Char]
"" -> []
                        Char
'{':Char
'-':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"{-") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
'-':Char
'}':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"-}") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
'{':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"{") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
'(':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"(") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
'`':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"`") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
'=':Char
'>':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"=>") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
'=':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"=") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
',':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
",") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        Char
':':Char
':':[Char]
xs -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
"::") forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
xs
                        [Char]
s' -> ([Char]
blanks' forall a. [a] -> [a] -> [a]
++ [Char]
w) forall a. a -> [a] -> [a]
: Bool -> [Char] -> [[Char]]
mywords Bool
spaced [Char]
s''
                              where ([Char]
w, [Char]
s'') = [Char] -> ([Char], [Char])
myBreak [Char]
s'
                                    myBreak :: [Char] -> ([Char], [Char])
myBreak [] = ([],[])
                                    myBreak (Char
':':Char
':':[Char]
xs) = ([], [Char]
"::"forall a. [a] -> [a] -> [a]
++[Char]
xs)
                                    myBreak (Char
')':[Char]
xs) = ([],Char
')'forall a. a -> [a] -> [a]
:[Char]
xs)
                                    myBreak (Char
'(':[Char]
xs) = ([],Char
'('forall a. a -> [a] -> [a]
:[Char]
xs)
                                    myBreak (Char
'`':[Char]
xs) = ([],Char
'`'forall a. a -> [a] -> [a]
:[Char]
xs)
                                    myBreak (Char
'=':[Char]
xs) = ([],Char
'='forall a. a -> [a] -> [a]
:[Char]
xs)
                                    myBreak (Char
',':[Char]
xs) = ([],Char
','forall a. a -> [a] -> [a]
:[Char]
xs)
                                    myBreak xss :: [Char]
xss@(Char
x:[Char]
xs)
                                      | Char -> Bool
isSpace Char
x
                                        = if Bool
spaced
                                          then ([], [Char]
xss)
                                          else ([], forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
xss)
                                      | Bool
otherwise = let ([Char]
a,[Char]
b) = [Char] -> ([Char], [Char])
myBreak [Char]
xs
                                                    in  (Char
xforall a. a -> [a] -> [a]
:[Char]
a,[Char]
b)
                    where blanks' :: [Char]
blanks' = if Bool
spaced then [Char]
blanks else [Char]
""
                          ([Char]
blanks, [Char]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span {-partain:Char.-}Char -> Bool
isSpace [Char]
s


type FileName = String

type ThingName = String

type Scope = Maybe (FoundThingType, String)

-- The position of a token or definition
data Pos = Pos { Pos -> [Char]
_fileName    :: FileName -- file name
               , Pos -> Int
_lineNumber  :: Int      -- line number
               , Pos -> Int
_tokenNumber :: Int      -- token number
               , Pos -> [Char]
_lineContent :: String   -- string that makes up that line
               }
   deriving (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> [Char]
$cshow :: Pos -> [Char]
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show,Pos -> Pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq,Typeable,Typeable Pos
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> Pos
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
forall u. (forall d. Data d => d -> u) -> Pos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
$cgmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
dataTypeOf :: Pos -> DataType
$cdataTypeOf :: Pos -> DataType
toConstr :: Pos -> Constr
$ctoConstr :: Pos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
Data)

-- A definition we have found
-- I'm not sure wether I've used the right names.. but I hope you fix it / get
-- what I mean
data FoundThingType
  = FTFuncTypeDef String Scope
    | FTFuncImpl Scope
    | FTType
    | FTData
    | FTDataGADT
    | FTNewtype
    | FTClass
    | FTInstance
    | FTModule
    | FTCons FoundThingType String
    | FTOther
    | FTConsAccessor FoundThingType String String
    | FTConsGADT String
    | FTPatternTypeDef String
    | FTPattern
  deriving (FoundThingType -> FoundThingType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FoundThingType -> FoundThingType -> Bool
$c/= :: FoundThingType -> FoundThingType -> Bool
== :: FoundThingType -> FoundThingType -> Bool
$c== :: FoundThingType -> FoundThingType -> Bool
Eq,Typeable,Typeable FoundThingType
FoundThingType -> DataType
FoundThingType -> Constr
(forall b. Data b => b -> b) -> FoundThingType -> FoundThingType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FoundThingType -> u
forall u. (forall d. Data d => d -> u) -> FoundThingType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThingType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThingType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FoundThingType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThingType -> c FoundThingType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FoundThingType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FoundThingType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FoundThingType -> m FoundThingType
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FoundThingType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FoundThingType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FoundThingType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FoundThingType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThingType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThingType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThingType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThingType -> r
gmapT :: (forall b. Data b => b -> b) -> FoundThingType -> FoundThingType
$cgmapT :: (forall b. Data b => b -> b) -> FoundThingType -> FoundThingType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FoundThingType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FoundThingType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FoundThingType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FoundThingType)
dataTypeOf :: FoundThingType -> DataType
$cdataTypeOf :: FoundThingType -> DataType
toConstr :: FoundThingType -> Constr
$ctoConstr :: FoundThingType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FoundThingType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FoundThingType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThingType -> c FoundThingType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThingType -> c FoundThingType
Data)

instance Show FoundThingType where
  show :: FoundThingType -> [Char]
show (FTFuncTypeDef [Char]
s (Just (FoundThingType
FTClass, [Char]
p))) =
      [Char]
"ft\t" forall a. [a] -> [a] -> [a]
++ [Char]
"signature:(" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
")\t" forall a. [a] -> [a] -> [a]
++ [Char]
"class:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show (FTFuncTypeDef [Char]
s (Just (FoundThingType
FTInstance, [Char]
p))) =
      [Char]
"ft\t" forall a. [a] -> [a] -> [a]
++ [Char]
"signature:(" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
")\t" forall a. [a] -> [a] -> [a]
++ [Char]
"instance:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show (FTFuncTypeDef [Char]
s Scope
_) = [Char]
"ft\t" forall a. [a] -> [a] -> [a]
++ [Char]
"signature:(" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show (FTFuncImpl (Just (FoundThingType
FTClass, [Char]
p)))= [Char]
"fi\t" forall a. [a] -> [a] -> [a]
++ [Char]
"class:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show (FTFuncImpl (Just (FoundThingType
FTInstance, [Char]
p)))= [Char]
"fi\t" forall a. [a] -> [a] -> [a]
++ [Char]
"instance:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show (FTFuncImpl Scope
_)= [Char]
"fi"
  show FoundThingType
FTType = [Char]
"t"
  show FoundThingType
FTData = [Char]
"d"
  show FoundThingType
FTDataGADT = [Char]
"d_gadt"
  show FoundThingType
FTNewtype = [Char]
"nt"
  show FoundThingType
FTClass = [Char]
"c"
  show FoundThingType
FTInstance = [Char]
"i"
  show FoundThingType
FTModule = [Char]
"m"
  show (FTCons FoundThingType
FTData [Char]
p) = [Char]
"cons\t" forall a. [a] -> [a] -> [a]
++ [Char]
"data:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show (FTCons FoundThingType
FTNewtype [Char]
p) = [Char]
"cons\t" forall a. [a] -> [a] -> [a]
++ [Char]
"newtype:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show FTCons {} = [Char]
"cons"
  show (FTConsGADT [Char]
p) = [Char]
"c_gadt\t" forall a. [a] -> [a] -> [a]
++ [Char]
"d_gadt:" forall a. [a] -> [a] -> [a]
++ [Char]
p
  show (FTConsAccessor FoundThingType
FTData [Char]
p [Char]
c) = [Char]
"c_a\t" forall a. [a] -> [a] -> [a]
++ [Char]
"cons:" forall a. [a] -> [a] -> [a]
++ [Char]
p forall a. [a] -> [a] -> [a]
++ [Char]
"." forall a. [a] -> [a] -> [a]
++ [Char]
c
  show (FTConsAccessor FoundThingType
FTNewtype [Char]
p [Char]
c) = [Char]
"c_a\t" forall a. [a] -> [a] -> [a]
++ [Char]
"cons:" forall a. [a] -> [a] -> [a]
++ [Char]
p forall a. [a] -> [a] -> [a]
++ [Char]
"." forall a. [a] -> [a] -> [a]
++ [Char]
c
  show FTConsAccessor {} = [Char]
"c_a"
  show (FTPatternTypeDef [Char]
s) = [Char]
"pt\t" forall a. [a] -> [a] -> [a]
++ [Char]
"signature:(" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
")"
  show FoundThingType
FTPattern = [Char]
"pi"
  show FoundThingType
FTOther = [Char]
"o"

data FoundThing = FoundThing FoundThingType ThingName Pos
        deriving (Int -> FoundThing -> ShowS
[FoundThing] -> ShowS
FoundThing -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FoundThing] -> ShowS
$cshowList :: [FoundThing] -> ShowS
show :: FoundThing -> [Char]
$cshow :: FoundThing -> [Char]
showsPrec :: Int -> FoundThing -> ShowS
$cshowsPrec :: Int -> FoundThing -> ShowS
Show,FoundThing -> FoundThing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FoundThing -> FoundThing -> Bool
$c/= :: FoundThing -> FoundThing -> Bool
== :: FoundThing -> FoundThing -> Bool
$c== :: FoundThing -> FoundThing -> Bool
Eq,Typeable,Typeable FoundThing
FoundThing -> DataType
FoundThing -> Constr
(forall b. Data b => b -> b) -> FoundThing -> FoundThing
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FoundThing -> u
forall u. (forall d. Data d => d -> u) -> FoundThing -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThing -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThing -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FoundThing
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThing -> c FoundThing
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FoundThing)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FoundThing)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FoundThing -> m FoundThing
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FoundThing -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FoundThing -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FoundThing -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FoundThing -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThing -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThing -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThing -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FoundThing -> r
gmapT :: (forall b. Data b => b -> b) -> FoundThing -> FoundThing
$cgmapT :: (forall b. Data b => b -> b) -> FoundThing -> FoundThing
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FoundThing)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FoundThing)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FoundThing)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FoundThing)
dataTypeOf :: FoundThing -> DataType
$cdataTypeOf :: FoundThing -> DataType
toConstr :: FoundThing -> Constr
$ctoConstr :: FoundThing -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FoundThing
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FoundThing
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThing -> c FoundThing
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThing -> c FoundThing
Data)

-- Data we have obtained from a file
data FileData = FileData FileName [FoundThing]
  deriving (Typeable,Typeable FileData
FileData -> DataType
FileData -> Constr
(forall b. Data b => b -> b) -> FileData -> FileData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FileData -> u
forall u. (forall d. Data d => d -> u) -> FileData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FileData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FileData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileData -> c FileData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FileData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FileData)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FileData -> m FileData
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FileData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FileData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FileData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FileData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FileData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FileData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FileData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FileData -> r
gmapT :: (forall b. Data b => b -> b) -> FileData -> FileData
$cgmapT :: (forall b. Data b => b -> b) -> FileData -> FileData
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FileData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FileData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FileData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FileData)
dataTypeOf :: FileData -> DataType
$cdataTypeOf :: FileData -> DataType
toConstr :: FileData -> Constr
$ctoConstr :: FileData -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FileData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileData -> c FileData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileData -> c FileData
Data,Int -> FileData -> ShowS
[FileData] -> ShowS
FileData -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FileData] -> ShowS
$cshowList :: [FileData] -> ShowS
show :: FileData -> [Char]
$cshow :: FileData -> [Char]
showsPrec :: Int -> FileData -> ShowS
$cshowsPrec :: Int -> FileData -> ShowS
Show)

makeLenses ''Pos

getfoundthings :: FileData -> [FoundThing]
getfoundthings :: FileData -> [FoundThing]
getfoundthings (FileData [Char]
_ [FoundThing]
things) = [FoundThing]
things

ctagEncode :: Char -> String
ctagEncode :: Char -> [Char]
ctagEncode Char
'/'  = [Char]
"\\/"
ctagEncode Char
'\\' = [Char]
"\\\\"
ctagEncode Char
a    = [Char
a]


showLine :: Pos -> String
showLine :: Pos -> [Char]
showLine = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Pos Int
lineNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Pos Int
lineNumber (forall a. Num a => a -> a -> a
+Int
1)

normalDump :: FoundThing -> String
normalDump :: FoundThing -> [Char]
normalDump (FoundThing FoundThingType
_ [Char]
n Pos
p) = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" [[Char]
n, Pos
pforall s a. s -> Getting a s a -> a
^.Lens' Pos [Char]
fileName, Pos -> [Char]
showLine Pos
p]

extendedDump :: FoundThing -> String
extendedDump :: FoundThing -> [Char]
extendedDump (FoundThing FoundThingType
t [Char]
n Pos
p) = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" [[Char]
n, Pos
pforall s a. s -> Getting a s a -> a
^.Lens' Pos [Char]
fileName, [Char]
content, [Char]
kindInfo, [Char]
lineInfo, [Char]
"language:Haskell"]
  where content :: [Char]
content = [Char]
"/^" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
ctagEncode (Pos
pforall s a. s -> Getting a s a -> a
^.Lens' Pos [Char]
lineContent) forall a. [a] -> [a] -> [a]
++ [Char]
"$/;\""
        kindInfo :: [Char]
kindInfo = forall a. Show a => a -> [Char]
show FoundThingType
t
        lineInfo :: [Char]
lineInfo = [Char]
"line:" forall a. [a] -> [a] -> [a]
++ Pos -> [Char]
showLine Pos
p

-- | Dump found tag in normal or extended (read : vim like) ctag
-- line
dumpThing :: Bool -> FoundThing -> String
dumpThing :: Bool -> FoundThing -> [Char]
dumpThing Bool
cond FoundThing
thing = if Bool
cond
                          then FoundThing -> [Char]
extendedDump FoundThing
thing
                          else FoundThing -> [Char]
normalDump FoundThing
thing

-- stuff for dealing with ctags output format
writectagsfile :: Bool -> [FileData] -> Handle -> IO ()
writectagsfile :: Bool -> [FileData] -> Handle -> IO ()
writectagsfile Bool
extended [FileData]
filedata Handle
ctagsfile = do
    let things :: [FoundThing]
things = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileData -> [FoundThing]
getfoundthings [FileData]
filedata
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
extended
         (do Handle -> [Char] -> IO ()
hPutStrLn
                 Handle
ctagsfile
               forall a b. (a -> b) -> a -> b
$ [Char]
"!_TAG_FILE_FORMAT\t2\t/extended format; --format=1 will not "
                 forall a. [a] -> [a] -> [a]
++ [Char]
"append ;\" to lines/"
             Handle -> [Char] -> IO ()
hPutStrLn
               Handle
ctagsfile
               [Char]
"!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted, 2=foldcase/"
             Handle -> [Char] -> IO ()
hPutStrLn Handle
ctagsfile [Char]
"!_TAG_PROGRAM_NAME\thasktags")
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> [Char] -> IO ()
hPutStrLn Handle
ctagsfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FoundThing -> [Char]
dumpThing Bool
extended) ([FoundThing] -> [FoundThing]
sortThings [FoundThing]
things)

sortThings :: [FoundThing] -> [FoundThing]
sortThings :: [FoundThing] -> [FoundThing]
sortThings = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy FoundThing -> FoundThing -> Ordering
comp
  where
        comp :: FoundThing -> FoundThing -> Ordering
comp (FoundThing FoundThingType
_ [Char]
a (Pos [Char]
f1 Int
l1 Int
_ [Char]
_)) (FoundThing FoundThingType
_ [Char]
b (Pos [Char]
f2 Int
l2 Int
_ [Char]
_)) =
            Ordering -> Ordering -> Ordering
c (Ordering -> Ordering -> Ordering
c (forall a. Ord a => a -> a -> Ordering
compare [Char]
a [Char]
b) (forall a. Ord a => a -> a -> Ordering
compare [Char]
f1 [Char]
f2)) (forall a. Ord a => a -> a -> Ordering
compare Int
l1 Int
l2)
        c :: Ordering -> Ordering -> Ordering
c Ordering
a Ordering
b = if Ordering
a forall a. Eq a => a -> a -> Bool
== Ordering
EQ then Ordering
b else Ordering
a


-- stuff for dealing with etags output format

writeetagsfile :: [FileData] -> Handle -> IO ()
writeetagsfile :: [FileData] -> Handle -> IO ()
writeetagsfile [FileData]
fileData Handle
etagsfile = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> [Char] -> IO ()
hPutStr Handle
etagsfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileData -> [Char]
etagsDumpFileData) [FileData]
fileData

etagsDumpFileData :: FileData -> String
etagsDumpFileData :: FileData -> [Char]
etagsDumpFileData (FileData [Char]
filename [FoundThing]
things) =
    [Char]
"\x0c\n" forall a. [a] -> [a] -> [a]
++ [Char]
filename forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
thingslength forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [Char]
thingsdump
    where thingsdump :: [Char]
thingsdump = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FoundThing -> [Char]
etagsDumpThing [FoundThing]
things
          thingslength :: Int
thingslength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
thingsdump

etagsDumpThing :: FoundThing -> String
etagsDumpThing :: FoundThing -> [Char]
etagsDumpThing (FoundThing FoundThingType
_ [Char]
name Pos
pos) =
  let line :: Int
line = Pos
posforall s a. s -> Getting a s a -> a
^.Lens' Pos Int
lineNumber
      token :: Int
token = Pos
posforall s a. s -> Getting a s a -> a
^.Lens' Pos Int
tokenNumber
      toks :: [[Char]]
toks = Bool -> [Char] -> [[Char]]
mywords Bool
True (Pos
posforall s a. s -> Getting a s a -> a
^.Lens' Pos [Char]
lineContent)
      lineIdentifier :: [Char]
lineIdentifier = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> [a] -> [a]
take Int
token [[Char]]
toks forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
take Int
1) (forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
token [[Char]]
toks))
  in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
lineIdentifier, [Char]
"\x7f", [Char]
name, [Char]
"\x01", forall a. Show a => a -> [Char]
show Int
line, [Char]
",", forall a. Show a => a -> [Char]
show (Int
line forall a. Num a => a -> a -> a
+ Int
1), [Char]
"\n"]