{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module contains the implementation of the @dhall tags@ command

module Dhall.Tags
    ( generate
    ) where

import Control.Exception  (SomeException (..), handle)
import Data.List          (foldl', isSuffixOf)
import Data.Maybe         (fromMaybe)
import Data.Text          (Text)
import Data.Text.Encoding (encodeUtf8)
import Dhall.Map          (foldMapWithKey)
import Dhall.Parser       (exprFromText)
import Dhall.Src          (Src (srcStart))
import Dhall.Syntax       (Binding (..), Expr (..), RecordField (..))
import Dhall.Util         (Input (..))
import System.FilePath    (takeFileName, (</>))
import Text.Megaparsec    (sourceColumn, sourceLine, unPos)

import qualified Data.ByteString  as BS (length)
import qualified Data.Map         as M
import qualified Data.Text        as T
import qualified Data.Text.IO     as TIO
import qualified System.Directory as SD

{-
    Documentation for the etags format is not very informative and not very correct.
    You can find some documentation here:
    https://en.wikipedia.org/wiki/Ctags#Etags_2
    and you can also check the source code here:
    http://cvs.savannah.gnu.org/viewvc/vtags/vtags/vtags.el?view=markup
-}

data LineColumn = LC
    { LineColumn -> Int
_lcLine :: Int
      -- ^ line number, starting from 1, where to find the tag
    , LineColumn -> Int
_lcColumn :: Int
      -- ^ column of line where tag is
    } deriving (LineColumn -> LineColumn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineColumn -> LineColumn -> Bool
$c/= :: LineColumn -> LineColumn -> Bool
== :: LineColumn -> LineColumn -> Bool
$c== :: LineColumn -> LineColumn -> Bool
Eq, Eq LineColumn
LineColumn -> LineColumn -> Bool
LineColumn -> LineColumn -> Ordering
LineColumn -> LineColumn -> LineColumn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineColumn -> LineColumn -> LineColumn
$cmin :: LineColumn -> LineColumn -> LineColumn
max :: LineColumn -> LineColumn -> LineColumn
$cmax :: LineColumn -> LineColumn -> LineColumn
>= :: LineColumn -> LineColumn -> Bool
$c>= :: LineColumn -> LineColumn -> Bool
> :: LineColumn -> LineColumn -> Bool
$c> :: LineColumn -> LineColumn -> Bool
<= :: LineColumn -> LineColumn -> Bool
$c<= :: LineColumn -> LineColumn -> Bool
< :: LineColumn -> LineColumn -> Bool
$c< :: LineColumn -> LineColumn -> Bool
compare :: LineColumn -> LineColumn -> Ordering
$ccompare :: LineColumn -> LineColumn -> Ordering
Ord, Int -> LineColumn -> ShowS
[LineColumn] -> ShowS
LineColumn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineColumn] -> ShowS
$cshowList :: [LineColumn] -> ShowS
show :: LineColumn -> String
$cshow :: LineColumn -> String
showsPrec :: Int -> LineColumn -> ShowS
$cshowsPrec :: Int -> LineColumn -> ShowS
Show)

data LineOffset = LO
    { LineOffset -> Int
loLine :: Int
      -- ^ line number, starting from 1, where to find the tag
    , LineOffset -> Int
loOffset :: Int
      -- ^ byte offset from start of file. Not sure if any editor uses it
    } deriving (LineOffset -> LineOffset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineOffset -> LineOffset -> Bool
$c/= :: LineOffset -> LineOffset -> Bool
== :: LineOffset -> LineOffset -> Bool
$c== :: LineOffset -> LineOffset -> Bool
Eq, Eq LineOffset
LineOffset -> LineOffset -> Bool
LineOffset -> LineOffset -> Ordering
LineOffset -> LineOffset -> LineOffset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineOffset -> LineOffset -> LineOffset
$cmin :: LineOffset -> LineOffset -> LineOffset
max :: LineOffset -> LineOffset -> LineOffset
$cmax :: LineOffset -> LineOffset -> LineOffset
>= :: LineOffset -> LineOffset -> Bool
$c>= :: LineOffset -> LineOffset -> Bool
> :: LineOffset -> LineOffset -> Bool
$c> :: LineOffset -> LineOffset -> Bool
<= :: LineOffset -> LineOffset -> Bool
$c<= :: LineOffset -> LineOffset -> Bool
< :: LineOffset -> LineOffset -> Bool
$c< :: LineOffset -> LineOffset -> Bool
compare :: LineOffset -> LineOffset -> Ordering
$ccompare :: LineOffset -> LineOffset -> Ordering
Ord, Int -> LineOffset -> ShowS
[LineOffset] -> ShowS
LineOffset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineOffset] -> ShowS
$cshowList :: [LineOffset] -> ShowS
show :: LineOffset -> String
$cshow :: LineOffset -> String
showsPrec :: Int -> LineOffset -> ShowS
$cshowsPrec :: Int -> LineOffset -> ShowS
Show)

newtype Tags = Tags (M.Map FilePath [(LineOffset, Tag)])

instance Semigroup Tags where
    (Tags Map String [(LineOffset, Tag)]
ts1) <> :: Tags -> Tags -> Tags
<> (Tags Map String [(LineOffset, Tag)]
ts2) = Map String [(LineOffset, Tag)] -> Tags
Tags (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map String [(LineOffset, Tag)]
ts1 Map String [(LineOffset, Tag)]
ts2)

instance Monoid Tags where
    mempty :: Tags
mempty = Map String [(LineOffset, Tag)] -> Tags
Tags forall k a. Map k a
M.empty

{-| For example, for the line: @let foo = \"foo\"@ the tag is:
    > Tag "let " "foo"
-}
data Tag = Tag
    { Tag -> Text
tagPattern :: Text
      -- ^ In vtags source code this field is named \"pattern\" and EMacs used it as
      --   a regex pattern to locate line with tag. It's looking for ^<tag pattern>.
      --   Looks like vi is not using it.
    , Tag -> Text
tagName :: Text
      -- ^ text, that editor compare with selected text. So it's really name of entity
    } deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show)

type LineNumber = Int

type ByteOffset = Int

{-| Generate etags for Dhall expressions
-}
generate
    :: Input
    -- ^ Where to look for files. This can be a directory name (@.@ for example),
    --   a file name or `StandardInput`. If `StandardInput`, then this will wait for
    --   file names from @STDIN@.
    --   This way someone can combine tools in @bash@ to send, for example, output from
    --   @find@ to the input of @dhall tags@.
    -> Maybe [Text]
    -- ^ List of suffixes for dhall files or Nothing to check all files
    -> Bool
    -- ^ Flag if `generate` should follow symlinks
    -> IO Text
    -- ^ Content for tags file
generate :: Input -> Maybe [Text] -> Bool -> IO Text
generate Input
inp Maybe [Text]
sxs Bool
followSyms = do
    [String]
files <- Bool -> Maybe [String] -> Input -> IO [String]
inputToFiles Bool
followSyms (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
sxs) Input
inp
    [Tags]
tags <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
f -> forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
                                   (String -> Text -> Tags
fileTags String
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
TIO.readFile String
f)) [String]
files
    forall (m :: * -> *) a. Monad m => a -> m a
return (Tags -> Text
showTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [Tags]
tags)

{-| Find tags in Text (second argument) and generates a list of them
    To make tags for filenames that works in both emacs and vi, add two initial tags.
    First for @filename@ for vi and second with @/filename@ for emacs.
    Other tags are working for both.
-}
fileTags :: FilePath -> Text -> Tags
fileTags :: String -> Text -> Tags
fileTags String
f Text
t = Map String [(LineOffset, Tag)] -> Tags
Tags (forall k a. k -> a -> Map k a
M.singleton String
f
                    ([(LineOffset, Tag)]
initialMap forall a. Semigroup a => a -> a -> a
<> Text -> [(LineOffset, Tag)]
getTagsFromText Text
t))
    where initialViTag :: (LineOffset, Tag)
initialViTag = (Int -> Int -> LineOffset
LO Int
1 Int
1, Text -> Text -> Tag
Tag Text
"" (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeFileName forall a b. (a -> b) -> a -> b
$ String
f))
          initialEmacsTag :: (LineOffset, Tag)
initialEmacsTag = (Int -> Int -> LineOffset
LO Int
1 Int
1, Text -> Text -> Tag
Tag Text
"" (Text
"/" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeFileName) String
f))
          initialMap :: [(LineOffset, Tag)]
initialMap = [(LineOffset, Tag)
initialViTag, (LineOffset, Tag)
initialEmacsTag]

getTagsFromText :: Text -> [(LineOffset, Tag)]
getTagsFromText :: Text -> [(LineOffset, Tag)]
getTagsFromText Text
t = case String -> Text -> Either ParseError (Expr Src Import)
exprFromText String
"" Text
t of
    Right Expr Src Import
expr -> Text -> [(LineColumn, Text)] -> [(LineOffset, Tag)]
fixPosAndDefinition Text
t (forall a. Expr Src a -> [(LineColumn, Text)]
getTagsFromExpr Expr Src Import
expr)
    Either ParseError (Expr Src Import)
_ -> forall a. Monoid a => a
mempty

{-| Used to update tag position and to build tag from term.
    After getTagsFromExpr line and column in line are in @LineColumn@ for each tag.
    And tagPattern is not added.
    Emacs use tag pattern to check if tag is on line. It compares line from start
    with tag pattern and in case they are the same, relocate user.
    fixPosAndDefinition change position to line and byte offset (@LineOffset@) and
    add tag pattern. For example, for Dhall string:

    >>> let dhallSource = "let foo = \"bar\"\nlet baz = \"qux\""

    Input for this function is:

    >>> foundTerms = [(LC 1 4, "foo"), (LC 2 4, "baz")]

    And:

    >>> fixPosAndDefinition dhallSource foundTerms
    [(LO {loLine = 1, loOffset = 5},Tag {tagPattern = "let foo ", tagName = "foo"}),(LO {loLine = 2, loOffset = 21},Tag {tagPattern = "let baz ", tagName = "baz"})]

    where 21 is byte offset from file start.
-}
fixPosAndDefinition :: Text -> [(LineColumn, Text)] -> [(LineOffset, Tag)]
fixPosAndDefinition :: Text -> [(LineColumn, Text)] -> [(LineOffset, Tag)]
fixPosAndDefinition Text
t = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(LC Int
ln Int
c, Text
term) ->
             let (Int
ln', Int
offset, Text
tPattern) = forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> (Int, Int, Text)
fallbackInfoForText Int
ln Int
c)
                                                     (Text -> Int -> Maybe (Int, Int, Text)
infoForText Text
term Int
ln)
             in [(Int -> Int -> LineOffset
LO Int
ln' Int
offset, Text -> Text -> Tag
Tag Text
tPattern Text
term)])
    where mls :: M.Map Int (Text, Int)
          -- ^ mls is map that for each line has length of file before this map and line content.
          --   In example above, first line is 15 bytes long and '\n', mls contain:
          --   (1, (16, "let foo = "bar"")
          --   That allow us to get byte offset easier.
          mls :: Map Int (Text, Int)
mls = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([(Int, (Text, Int))], Int)
-> (Int, Text) -> ([(Int, (Text, Int))], Int)
processLine ([], Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t

          {-| processLine is a worker for `foldl` that generates the list of lines with
              byte offsets from the start of the first line from a list of lines
          -}
          processLine
              :: ([(LineNumber, (Text, ByteOffset))], ByteOffset)
              -- ^ previous result and byte offset for the start of current line
              -> (LineNumber, Text)
              -> ([(LineNumber, (Text, ByteOffset))], ByteOffset)
              -- ^ next result, where new line was added and byte offset for next line
          processLine :: ([(Int, (Text, Int))], Int)
-> (Int, Text) -> ([(Int, (Text, Int))], Int)
processLine ([(Int, (Text, Int))]
numberedLinesWithSizes, Int
bytesBeforeLine) (Int
n, Text
line) =
              ((Int
n, (Text
line, Int
bytesBeforeLine))forall a. a -> [a] -> [a]
: [(Int, (Text, Int))]
numberedLinesWithSizes, Int
bytesBeforeNextLine)
              where bytesBeforeNextLine :: Int
bytesBeforeNextLine = Int
bytesBeforeLine forall a. Num a => a -> a -> a
+ Text -> Int
lengthInBytes Text
line forall a. Num a => a -> a -> a
+ Int
1

          lineFromMap :: Int -> (Text, Int)
lineFromMap Int
ln = forall a. a -> Maybe a -> a
fromMaybe (Text
"", Int
0) (Int
ln forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int (Text, Int)
mls)

          lengthInBytes :: Text -> Int
lengthInBytes = ByteString -> Int
BS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

          {-| get information about term from map of lines
              In most cases, @LineColumn@ after `getTagsFromExpr` points to byte before term.
              It's better to have term in term pattern, so this function finds and updates
              line number and byte offset and generate pattern.
          -}
          infoForText
              :: Text
              -- ^ term to find
              -> Int
              -- ^ line where to start
              -> Maybe (Int, Int, Text)
              -- ^ (Line number, byte offset, pattern to find term in file)
          infoForText :: Text -> Int -> Maybe (Int, Int, Text)
infoForText Text
term Int
ln
              | Int
ln forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
              | Text -> Bool
T.null Text
part2 = Text -> Int -> Maybe (Int, Int, Text)
infoForText Text
term (Int
ln forall a. Num a => a -> a -> a
- Int
1)
              | Bool
otherwise = forall a. a -> Maybe a
Just (Int
ln, Int
lsl forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Text -> Int
lengthInBytes Text
part1, Text
part1 forall a. Semigroup a => a -> a -> a
<> Text
termAndNext)
              where (Text
l, Int
lsl) = Int -> (Text, Int)
lineFromMap Int
ln
                    (Text
part1, Text
part2) = Text -> Text -> (Text, Text)
T.breakOn Text
term Text
l
                    termAndNext :: Text
termAndNext = Int -> Text -> Text
T.take (Text -> Int
T.length Text
term forall a. Num a => a -> a -> a
+ Int
1) Text
part2

          fallbackInfoForText :: Int -> Int -> (Int, Int, Text)
fallbackInfoForText Int
ln Int
c = (Int
ln, Int
lsl forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Text -> Int
lengthInBytes Text
pat, Text
pat)
              where (Text
l, Int
lsl) = Int -> (Text, Int)
lineFromMap Int
ln
                    pat :: Text
pat = Int -> Text -> Text
T.take Int
c Text
l

getTagsFromExpr :: Expr Src a -> [(LineColumn, Text)]
getTagsFromExpr :: forall a. Expr Src a -> [(LineColumn, Text)]
getTagsFromExpr = forall {a}.
LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go (Int -> Int -> LineColumn
LC Int
0 Int
0) []
    where go :: LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
lpos [(LineColumn, Text)]
mts = \case
              (Let Binding Src a
b Expr Src a
e) -> LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
lpos ([(LineColumn, Text)]
mts forall a. Semigroup a => a -> a -> a
<> forall a. LineColumn -> Binding Src a -> [(LineColumn, Text)]
parseBinding LineColumn
lpos Binding Src a
b) Expr Src a
e
              (Annot Expr Src a
e1 Expr Src a
e2) -> LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
lpos (LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
lpos [(LineColumn, Text)]
mts Expr Src a
e1) Expr Src a
e2
              (Record Map Text (RecordField Src a)
mr) -> [(LineColumn, Text)]
mts forall a. Semigroup a => a -> a -> a
<> LineColumn -> Map Text (Expr Src a) -> [(LineColumn, Text)]
tagsFromDhallMap LineColumn
lpos (forall s a. RecordField s a -> Expr s a
recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Src a)
mr)
              (RecordLit Map Text (RecordField Src a)
mr) -> [(LineColumn, Text)]
mts forall a. Semigroup a => a -> a -> a
<> LineColumn -> Map Text (Expr Src a) -> [(LineColumn, Text)]
tagsFromDhallMap LineColumn
lpos (forall s a. RecordField s a -> Expr s a
recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Src a)
mr)
              (Union Map Text (Maybe (Expr Src a))
mmr) -> [(LineColumn, Text)]
mts forall a. Semigroup a => a -> a -> a
<> LineColumn -> Map Text (Maybe (Expr Src a)) -> [(LineColumn, Text)]
tagsFromDhallMapMaybe LineColumn
lpos Map Text (Maybe (Expr Src a))
mmr
              (Note Src
s Expr Src a
e) -> LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go (Src -> LineColumn
srcToLineColumn Src
s) [(LineColumn, Text)]
mts Expr Src a
e
              Expr Src a
_ -> [(LineColumn, Text)]
mts

          tagsFromDhallMap :: LineColumn -> Map Text (Expr Src a) -> [(LineColumn, Text)]
tagsFromDhallMap LineColumn
lpos = forall m k a. (Monoid m, Ord k) => (k -> a -> m) -> Map k a -> m
foldMapWithKey (LineColumn -> Text -> Expr Src a -> [(LineColumn, Text)]
tagsFromDhallMapElement LineColumn
lpos)

          tagsFromDhallMapMaybe :: LineColumn -> Map Text (Maybe (Expr Src a)) -> [(LineColumn, Text)]
tagsFromDhallMapMaybe LineColumn
lpos = forall m k a. (Monoid m, Ord k) => (k -> a -> m) -> Map k a -> m
foldMapWithKey (\Text
k -> \case
              Just Expr Src a
e -> LineColumn -> Text -> Expr Src a -> [(LineColumn, Text)]
tagsFromDhallMapElement LineColumn
lpos Text
k Expr Src a
e
              Maybe (Expr Src a)
_ -> [(LineColumn
lpos, Text
k)])

          tagsFromDhallMapElement :: LineColumn -> Text -> Expr Src a -> [(LineColumn, Text)]
tagsFromDhallMapElement LineColumn
lpos Text
k Expr Src a
e = LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
pos [(LineColumn
pos, Text
k)] Expr Src a
e
              where pos :: LineColumn
pos = forall a. LineColumn -> Expr Src a -> LineColumn
firstPosFromExpr LineColumn
lpos Expr Src a
e

          parseBinding :: LineColumn -> Binding Src a -> [(LineColumn, Text)]
          parseBinding :: forall a. LineColumn -> Binding Src a -> [(LineColumn, Text)]
parseBinding LineColumn
lpos Binding Src a
b = forall {a}.
LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
p2 [(LineColumn
p0, forall s a. Binding s a -> Text
variable Binding Src a
b)] (forall s a. Binding s a -> Expr s a
value Binding Src a
b)
              where p0 :: LineColumn
p0 = Maybe Src -> LineColumn -> LineColumn
posFromBinding (forall s a. Binding s a -> Maybe s
bindingSrc0 Binding Src a
b) LineColumn
lpos
                    p1 :: LineColumn
p1 = Maybe Src -> LineColumn -> LineColumn
posFromBinding (forall s a. Binding s a -> Maybe s
bindingSrc1 Binding Src a
b) LineColumn
p0
                    p2 :: LineColumn
p2 = Maybe Src -> LineColumn -> LineColumn
posFromBinding (forall s a. Binding s a -> Maybe s
bindingSrc2 Binding Src a
b) LineColumn
p1
          posFromBinding :: Maybe Src -> LineColumn -> LineColumn
posFromBinding Maybe Src
src LineColumn
startPos = forall b a. b -> (a -> b) -> Maybe a -> b
maybe LineColumn
startPos Src -> LineColumn
srcToLineColumn Maybe Src
src

srcToLineColumn :: Src -> LineColumn
srcToLineColumn :: Src -> LineColumn
srcToLineColumn Src
s = Int -> Int -> LineColumn
LC Int
line Int
column
    where ssp :: SourcePos
ssp = Src -> SourcePos
srcStart Src
s
          line :: Int
line = Pos -> Int
unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceLine forall a b. (a -> b) -> a -> b
$ SourcePos
ssp
          column :: Int
column = Pos -> Int
unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceColumn forall a b. (a -> b) -> a -> b
$ SourcePos
ssp

firstPosFromExpr :: LineColumn -> Expr Src a -> LineColumn
firstPosFromExpr :: forall a. LineColumn -> Expr Src a -> LineColumn
firstPosFromExpr LineColumn
lpos = \case
    (Note Src
s Expr Src a
_) -> Src -> LineColumn
srcToLineColumn Src
s
    Expr Src a
_ -> LineColumn
lpos

showTags :: Tags -> Text
showTags :: Tags -> Text
showTags (Tags Map String [(LineOffset, Tag)]
ts) = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [(LineOffset, Tag)] -> Text
showFileTags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Map String [(LineOffset, Tag)]
ts

showFileTags :: FilePath -> [(LineOffset, Tag)] -> T.Text
showFileTags :: String -> [(LineOffset, Tag)] -> Text
showFileTags String
f [(LineOffset, Tag)]
ts = Text
"\x0c\n" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
f forall a. Semigroup a => a -> a -> a
<> Text
"," forall a. Semigroup a => a -> a -> a
<> (Int -> Text
showInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) Text
cs forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
cs
    where cs :: Text
cs = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LineOffset -> Tag -> Text
showPosTag) forall a b. (a -> b) -> a -> b
$ [(LineOffset, Tag)]
ts

showPosTag :: LineOffset -> Tag -> Text
showPosTag :: LineOffset -> Tag -> Text
showPosTag LineOffset
lo Tag
tag = Text
def forall a. Semigroup a => a -> a -> a
<>Text
"\x7f" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"\x01" forall a. Semigroup a => a -> a -> a
<> Int -> Text
showInt Int
line forall a. Semigroup a => a -> a -> a
<>
                    Text
"," forall a. Semigroup a => a -> a -> a
<> Int -> Text
showInt Int
offset forall a. Semigroup a => a -> a -> a
<> Text
"\n"
    where line :: Int
line = LineOffset -> Int
loLine LineOffset
lo
          offset :: Int
offset = LineOffset -> Int
loOffset LineOffset
lo
          def :: Text
def = Tag -> Text
tagPattern Tag
tag
          name :: Text
name = Tag -> Text
tagName Tag
tag

showInt :: Int -> Text
showInt :: Int -> Text
showInt = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

{-| Generate list of files for a given `Input`
-}
inputToFiles
    :: Bool
    -- ^ If `True`, this function will follow  symbolic links
    -> Maybe [String]
    -- ^ List of suffixes. If `Nothing`, all files will be returned.
    --   This parameter only works when the `Input` is an `InputFile` and point to a directory.
    -> Input
    -> IO [ FilePath ]
    --   List of files.
inputToFiles :: Bool -> Maybe [String] -> Input -> IO [String]
inputToFiles Bool
_ Maybe [String]
_ Input
StandardInput = String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getContents
inputToFiles Bool
followSyms Maybe [String]
suffixes (InputFile String
path) = String -> IO [String]
go String
path
    where go :: String -> IO [String]
go String
p = do
                   Bool
isD <- String -> IO Bool
SD.doesDirectoryExist String
p
                   Bool
isSL <- IO Bool
isSymLink
                   if Bool
isD
                     then if Bool
isSL Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
followSyms
                            then forall (m :: * -> *) a. Monad m => a -> m a
return []
                            else do
                                   -- filter . .. and hidden files .*
                                   [String]
contents <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(/=) Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head))
                                                    (String -> IO [String]
SD.getDirectoryContents String
p)
                                   forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO [String]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
(</>) String
p) [String]
contents
                     else forall (m :: * -> *) a. Monad m => a -> m a
return [String
p | Bool
matchingSuffix Bool -> Bool -> Bool
|| String
p forall a. Eq a => a -> a -> Bool
== String
path]
               where matchingSuffix :: Bool
matchingSuffix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
p)) Maybe [String]
suffixes
                     isSymLink :: IO Bool
isSymLink = String -> IO Bool
SD.pathIsSymbolicLink String
p