{-# 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 -> String -> [String]
mywords Bool
spaced String
s =  case String
rest of
                        Char
')':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        String
"" -> []
                        Char
'{':Char
'-':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{-") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
'-':Char
'}':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-}") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
'{':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
'(':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
'`':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
'=':Char
'>':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=>") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
'=':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
',':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        Char
':':Char
':':String
xs -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
xs
                        String
s' -> (String
blanks' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> String -> [String]
mywords Bool
spaced String
s''
                              where (String
w, String
s'') = String -> (String, String)
myBreak String
s'
                                    myBreak :: String -> (String, String)
myBreak [] = ([],[])
                                    myBreak (Char
':':Char
':':String
xs) = ([], String
"::"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
xs)
                                    myBreak (Char
')':String
xs) = ([],Char
')'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                                    myBreak (Char
'(':String
xs) = ([],Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                                    myBreak (Char
'`':String
xs) = ([],Char
'`'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                                    myBreak (Char
'=':String
xs) = ([],Char
'='Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                                    myBreak (Char
',':String
xs) = ([],Char
','Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
                                    myBreak xss :: String
xss@(Char
x:String
xs)
                                      | Char -> Bool
isSpace Char
x
                                        = if Bool
spaced
                                          then ([], String
xss)
                                          else ([], (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
xss)
                                      | Bool
otherwise = let (String
a,String
b) = String -> (String, String)
myBreak String
xs
                                                    in  (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
a,String
b)
                    where blanks' :: String
blanks' = if Bool
spaced then String
blanks else String
""
                          (String
blanks, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span {-partain:Char.-}Char -> Bool
isSpace String
s


type FileName = String

type ThingName = String

type Scope = Maybe (FoundThingType, String)

-- The position of a token or definition
data Pos = Pos { Pos -> String
_fileName    :: FileName -- file name
               , Pos -> Int
_lineNumber  :: Int      -- line number
               , Pos -> Int
_tokenNumber :: Int      -- token number
               , Pos -> String
_lineContent :: String   -- string that makes up that line
               }
   deriving (Int -> Pos -> String -> String
[Pos] -> String -> String
Pos -> String
(Int -> Pos -> String -> String)
-> (Pos -> String) -> ([Pos] -> String -> String) -> Show Pos
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Pos] -> String -> String
$cshowList :: [Pos] -> String -> String
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> String -> String
$cshowsPrec :: Int -> Pos -> String -> String
Show,Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
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
Constr
DataType
Typeable Pos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pos -> c Pos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pos)
-> (Pos -> Constr)
-> (Pos -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Pos -> Pos)
-> (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 u. (forall d. Data d => d -> u) -> Pos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> Data Pos
Pos -> Constr
Pos -> DataType
(forall b. Data b => b -> b) -> Pos -> Pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cPos :: Constr
$tPos :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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
(FoundThingType -> FoundThingType -> Bool)
-> (FoundThingType -> FoundThingType -> Bool) -> Eq FoundThingType
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
Constr
DataType
Typeable FoundThingType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FoundThingType -> c FoundThingType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FoundThingType)
-> (FoundThingType -> Constr)
-> (FoundThingType -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> FoundThingType -> FoundThingType)
-> (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 u.
    (forall d. Data d => d -> u) -> FoundThingType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FoundThingType -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FoundThingType -> m FoundThingType)
-> Data FoundThingType
FoundThingType -> Constr
FoundThingType -> DataType
(forall b. Data b => b -> b) -> FoundThingType -> FoundThingType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThingType -> c FoundThingType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cFTPattern :: Constr
$cFTPatternTypeDef :: Constr
$cFTConsGADT :: Constr
$cFTConsAccessor :: Constr
$cFTOther :: Constr
$cFTCons :: Constr
$cFTModule :: Constr
$cFTInstance :: Constr
$cFTClass :: Constr
$cFTNewtype :: Constr
$cFTDataGADT :: Constr
$cFTData :: Constr
$cFTType :: Constr
$cFTFuncImpl :: Constr
$cFTFuncTypeDef :: Constr
$tFoundThingType :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> FoundThingType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FoundThingType -> u
gmapQ :: (forall d. Data d => d -> u) -> FoundThingType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FoundThingType -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable FoundThingType
Data)

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

data FoundThing = FoundThing FoundThingType ThingName Pos
        deriving (Int -> FoundThing -> String -> String
[FoundThing] -> String -> String
FoundThing -> String
(Int -> FoundThing -> String -> String)
-> (FoundThing -> String)
-> ([FoundThing] -> String -> String)
-> Show FoundThing
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FoundThing] -> String -> String
$cshowList :: [FoundThing] -> String -> String
show :: FoundThing -> String
$cshow :: FoundThing -> String
showsPrec :: Int -> FoundThing -> String -> String
$cshowsPrec :: Int -> FoundThing -> String -> String
Show,FoundThing -> FoundThing -> Bool
(FoundThing -> FoundThing -> Bool)
-> (FoundThing -> FoundThing -> Bool) -> Eq FoundThing
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
Constr
DataType
Typeable FoundThing
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FoundThing -> c FoundThing)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FoundThing)
-> (FoundThing -> Constr)
-> (FoundThing -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> FoundThing -> FoundThing)
-> (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 u. (forall d. Data d => d -> u) -> FoundThing -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FoundThing -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FoundThing -> m FoundThing)
-> Data FoundThing
FoundThing -> Constr
FoundThing -> DataType
(forall b. Data b => b -> b) -> FoundThing -> FoundThing
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FoundThing -> c FoundThing
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cFoundThing :: Constr
$tFoundThing :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> FoundThing -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FoundThing -> u
gmapQ :: (forall d. Data d => d -> u) -> FoundThing -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FoundThing -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable FoundThing
Data)

-- Data we have obtained from a file
data FileData = FileData FileName [FoundThing]
  deriving (Typeable,Typeable FileData
Constr
DataType
Typeable FileData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FileData -> c FileData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FileData)
-> (FileData -> Constr)
-> (FileData -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> FileData -> FileData)
-> (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 u. (forall d. Data d => d -> u) -> FileData -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FileData -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FileData -> m FileData)
-> Data FileData
FileData -> Constr
FileData -> DataType
(forall b. Data b => b -> b) -> FileData -> FileData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FileData -> c FileData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cFileData :: Constr
$tFileData :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> FileData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FileData -> u
gmapQ :: (forall d. Data d => d -> u) -> FileData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FileData -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable FileData
Data,Int -> FileData -> String -> String
[FileData] -> String -> String
FileData -> String
(Int -> FileData -> String -> String)
-> (FileData -> String)
-> ([FileData] -> String -> String)
-> Show FileData
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FileData] -> String -> String
$cshowList :: [FileData] -> String -> String
show :: FileData -> String
$cshow :: FileData -> String
showsPrec :: Int -> FileData -> String -> String
$cshowsPrec :: Int -> FileData -> String -> String
Show)

makeLenses ''Pos

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

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


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

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

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

-- | Dump found tag in normal or extended (read : vim like) ctag
-- line
dumpThing :: Bool -> FoundThing -> String
dumpThing :: Bool -> FoundThing -> String
dumpThing Bool
cond FoundThing
thing = if Bool
cond
                          then FoundThing -> String
extendedDump FoundThing
thing
                          else FoundThing -> String
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 = (FileData -> [FoundThing]) -> [FileData] -> [FoundThing]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileData -> [FoundThing]
getfoundthings [FileData]
filedata
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
extended
         (do Handle -> String -> IO ()
hPutStrLn
                 Handle
ctagsfile
               (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"!_TAG_FILE_FORMAT\t2\t/extended format; --format=1 will not "
                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"append ;\" to lines/"
             Handle -> String -> IO ()
hPutStrLn
               Handle
ctagsfile
               String
"!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted, 2=foldcase/"
             Handle -> String -> IO ()
hPutStrLn Handle
ctagsfile String
"!_TAG_PROGRAM_NAME\thasktags")
    (FoundThing -> IO ()) -> [FoundThing] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
ctagsfile (String -> IO ()) -> (FoundThing -> String) -> FoundThing -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FoundThing -> String
dumpThing Bool
extended) ([FoundThing] -> [FoundThing]
sortThings [FoundThing]
things)

sortThings :: [FoundThing] -> [FoundThing]
sortThings :: [FoundThing] -> [FoundThing]
sortThings = (FoundThing -> FoundThing -> Ordering)
-> [FoundThing] -> [FoundThing]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy FoundThing -> FoundThing -> Ordering
comp
  where
        comp :: FoundThing -> FoundThing -> Ordering
comp (FoundThing FoundThingType
_ String
a (Pos String
f1 Int
l1 Int
_ String
_)) (FoundThing FoundThingType
_ String
b (Pos String
f2 Int
l2 Int
_ String
_)) =
            Ordering -> Ordering -> Ordering
c (Ordering -> Ordering -> Ordering
c (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
a String
b) (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
f1 String
f2)) (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l1 Int
l2)
        c :: Ordering -> Ordering -> Ordering
c Ordering
a Ordering
b = if Ordering
a Ordering -> Ordering -> Bool
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 = (FileData -> IO ()) -> [FileData] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStr Handle
etagsfile (String -> IO ()) -> (FileData -> String) -> FileData -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileData -> String
etagsDumpFileData) [FileData]
fileData

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

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