{-# 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
(LineColumn -> LineColumn -> Bool)
-> (LineColumn -> LineColumn -> Bool) -> Eq LineColumn
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
Eq LineColumn
-> (LineColumn -> LineColumn -> Ordering)
-> (LineColumn -> LineColumn -> Bool)
-> (LineColumn -> LineColumn -> Bool)
-> (LineColumn -> LineColumn -> Bool)
-> (LineColumn -> LineColumn -> Bool)
-> (LineColumn -> LineColumn -> LineColumn)
-> (LineColumn -> LineColumn -> LineColumn)
-> Ord 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
$cp1Ord :: Eq LineColumn
Ord, Int -> LineColumn -> ShowS
[LineColumn] -> ShowS
LineColumn -> String
(Int -> LineColumn -> ShowS)
-> (LineColumn -> String)
-> ([LineColumn] -> ShowS)
-> Show LineColumn
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
(LineOffset -> LineOffset -> Bool)
-> (LineOffset -> LineOffset -> Bool) -> Eq LineOffset
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
Eq LineOffset
-> (LineOffset -> LineOffset -> Ordering)
-> (LineOffset -> LineOffset -> Bool)
-> (LineOffset -> LineOffset -> Bool)
-> (LineOffset -> LineOffset -> Bool)
-> (LineOffset -> LineOffset -> Bool)
-> (LineOffset -> LineOffset -> LineOffset)
-> (LineOffset -> LineOffset -> LineOffset)
-> Ord 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
$cp1Ord :: Eq LineOffset
Ord, Int -> LineOffset -> ShowS
[LineOffset] -> ShowS
LineOffset -> String
(Int -> LineOffset -> ShowS)
-> (LineOffset -> String)
-> ([LineOffset] -> ShowS)
-> Show LineOffset
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 (([(LineOffset, Tag)] -> [(LineOffset, Tag)] -> [(LineOffset, Tag)])
-> Map String [(LineOffset, Tag)]
-> Map String [(LineOffset, Tag)]
-> Map String [(LineOffset, Tag)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [(LineOffset, Tag)] -> [(LineOffset, Tag)] -> [(LineOffset, Tag)]
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 Map String [(LineOffset, Tag)]
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
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
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 ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> Maybe [Text] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
sxs) Input
inp
    [Tags]
tags <- (String -> IO Tags) -> [String] -> IO [Tags]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
f -> (SomeException -> IO Tags) -> IO Tags -> IO Tags
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> Tags -> IO Tags
forall (m :: * -> *) a. Monad m => a -> m a
return Tags
forall a. Monoid a => a
mempty)
                                   (String -> Text -> Tags
fileTags String
f (Text -> Tags) -> IO Text -> IO Tags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
TIO.readFile String
f)) [String]
files
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Tags -> Text
showTags (Tags -> Text) -> ([Tags] -> Tags) -> [Tags] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tags] -> Tags
forall a. Monoid a => [a] -> a
mconcat ([Tags] -> Text) -> [Tags] -> Text
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 (String -> [(LineOffset, Tag)] -> Map String [(LineOffset, Tag)]
forall k a. k -> a -> Map k a
M.singleton String
f
                    ([(LineOffset, Tag)]
initialMap [(LineOffset, Tag)] -> [(LineOffset, Tag)] -> [(LineOffset, Tag)]
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 (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeFileName (String -> Text) -> String -> Text
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
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
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 (Expr Src Import -> [(LineColumn, Text)]
forall a. Expr Src a -> [(LineColumn, Text)]
getTagsFromExpr Expr Src Import
expr)
    Either ParseError (Expr Src Import)
_ -> [(LineOffset, Tag)]
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 = ((LineColumn, Text) -> [(LineOffset, Tag)])
-> [(LineColumn, Text)] -> [(LineOffset, Tag)]
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) = (Int, Int, Text) -> Maybe (Int, Int, Text) -> (Int, Int, Text)
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 = [(Int, (Text, Int))] -> Map Int (Text, Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, (Text, Int))] -> Map Int (Text, Int))
-> ([Text] -> [(Int, (Text, Int))])
-> [Text]
-> Map Int (Text, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, (Text, Int))], Int) -> [(Int, (Text, Int))]
forall a b. (a, b) -> a
fst (([(Int, (Text, Int))], Int) -> [(Int, (Text, Int))])
-> ([Text] -> ([(Int, (Text, Int))], Int))
-> [Text]
-> [(Int, (Text, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Int, (Text, Int))], Int)
 -> (Int, Text) -> ([(Int, (Text, Int))], Int))
-> ([(Int, (Text, Int))], Int)
-> [(Int, Text)]
-> ([(Int, (Text, Int))], Int)
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) ([(Int, Text)] -> ([(Int, (Text, Int))], Int))
-> ([Text] -> [(Int, Text)])
-> [Text]
-> ([(Int, (Text, Int))], Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([Text] -> Map Int (Text, Int)) -> [Text] -> Map Int (Text, Int)
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))(Int, (Text, Int)) -> [(Int, (Text, Int))] -> [(Int, (Text, Int))]
forall a. a -> [a] -> [a]
: [(Int, (Text, Int))]
numberedLinesWithSizes, Int
bytesBeforeNextLine)
              where bytesBeforeNextLine :: Int
bytesBeforeNextLine = Int
bytesBeforeLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
lengthInBytes Text
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

          lineFromMap :: Int -> (Text, Int)
lineFromMap Int
ln = (Text, Int) -> Maybe (Text, Int) -> (Text, Int)
forall a. a -> Maybe a -> a
fromMaybe (Text
"", Int
0) (Int
ln Int -> Map Int (Text, Int) -> Maybe (Text, Int)
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 (ByteString -> Int) -> (Text -> ByteString) -> Text -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (Int, Int, Text)
forall a. Maybe a
Nothing
              | Text -> Bool
T.null Text
part2 = Text -> Int -> Maybe (Int, Int, Text)
infoForText Text
term (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              | Bool
otherwise = (Int, Int, Text) -> Maybe (Int, Int, Text)
forall a. a -> Maybe a
Just (Int
ln, Int
lsl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
lengthInBytes Text
part1, Text
part1 Text -> Text -> Text
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 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
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 :: Expr Src a -> [(LineColumn, Text)]
getTagsFromExpr = LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
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 [(LineColumn, Text)]
-> [(LineColumn, Text)] -> [(LineColumn, Text)]
forall a. Semigroup a => a -> a -> a
<> LineColumn -> Binding Src a -> [(LineColumn, Text)]
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 [(LineColumn, Text)]
-> [(LineColumn, Text)] -> [(LineColumn, Text)]
forall a. Semigroup a => a -> a -> a
<> LineColumn -> Map Text (Expr Src a) -> [(LineColumn, Text)]
tagsFromDhallMap LineColumn
lpos (RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
recordFieldValue (RecordField Src a -> Expr Src a)
-> Map Text (RecordField Src a) -> Map Text (Expr Src a)
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 [(LineColumn, Text)]
-> [(LineColumn, Text)] -> [(LineColumn, Text)]
forall a. Semigroup a => a -> a -> a
<> LineColumn -> Map Text (Expr Src a) -> [(LineColumn, Text)]
tagsFromDhallMap LineColumn
lpos (RecordField Src a -> Expr Src a
forall s a. RecordField s a -> Expr s a
recordFieldValue (RecordField Src a -> Expr Src a)
-> Map Text (RecordField Src a) -> Map Text (Expr Src a)
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 [(LineColumn, Text)]
-> [(LineColumn, Text)] -> [(LineColumn, Text)]
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 = (Text -> Expr Src a -> [(LineColumn, Text)])
-> Map Text (Expr Src a) -> [(LineColumn, Text)]
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 = (Text -> Maybe (Expr Src a) -> [(LineColumn, Text)])
-> Map Text (Maybe (Expr Src a)) -> [(LineColumn, Text)]
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 = LineColumn -> Expr Src a -> LineColumn
forall a. LineColumn -> Expr Src a -> LineColumn
firstPosFromExpr LineColumn
lpos Expr Src a
e

          parseBinding :: LineColumn -> Binding Src a -> [(LineColumn, Text)]
          parseBinding :: LineColumn -> Binding Src a -> [(LineColumn, Text)]
parseBinding LineColumn
lpos Binding Src a
b = LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
forall a.
LineColumn
-> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
go LineColumn
p2 [(LineColumn
p0, Binding Src a -> Text
forall s a. Binding s a -> Text
variable Binding Src a
b)] (Binding Src a -> Expr Src a
forall s a. Binding s a -> Expr s a
value Binding Src a
b)
              where p0 :: LineColumn
p0 = Maybe Src -> LineColumn -> LineColumn
posFromBinding (Binding Src a -> Maybe Src
forall s a. Binding s a -> Maybe s
bindingSrc0 Binding Src a
b) LineColumn
lpos
                    p1 :: LineColumn
p1 = Maybe Src -> LineColumn -> LineColumn
posFromBinding (Binding Src a -> Maybe Src
forall s a. Binding s a -> Maybe s
bindingSrc1 Binding Src a
b) LineColumn
p0
                    p2 :: LineColumn
p2 = Maybe Src -> LineColumn -> LineColumn
posFromBinding (Binding Src a -> Maybe Src
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 = LineColumn -> (Src -> LineColumn) -> Maybe Src -> LineColumn
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 (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceLine (SourcePos -> Int) -> SourcePos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos
ssp
          column :: Int
column = Pos -> Int
unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceColumn (SourcePos -> Int) -> SourcePos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos
ssp

firstPosFromExpr :: LineColumn -> Expr Src a -> LineColumn
firstPosFromExpr :: 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 ([Text] -> Text)
-> (Map String [(LineOffset, Tag)] -> [Text])
-> Map String [(LineOffset, Tag)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [(LineOffset, Tag)]) -> Text)
-> [(String, [(LineOffset, Tag)])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [(LineOffset, Tag)] -> Text)
-> (String, [(LineOffset, Tag)]) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [(LineOffset, Tag)] -> Text
showFileTags) ([(String, [(LineOffset, Tag)])] -> [Text])
-> (Map String [(LineOffset, Tag)]
    -> [(String, [(LineOffset, Tag)])])
-> Map String [(LineOffset, Tag)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String [(LineOffset, Tag)] -> [(String, [(LineOffset, Tag)])]
forall k a. Map k a -> [(k, a)]
M.toList (Map String [(LineOffset, Tag)] -> Text)
-> Map String [(LineOffset, Tag)] -> Text
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
showInt (Int -> Text) -> (Text -> Int) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) Text
cs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs
    where cs :: Text
cs = [Text] -> Text
T.concat ([Text] -> Text)
-> ([(LineOffset, Tag)] -> [Text]) -> [(LineOffset, Tag)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LineOffset, Tag) -> Text) -> [(LineOffset, Tag)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((LineOffset -> Tag -> Text) -> (LineOffset, Tag) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LineOffset -> Tag -> Text
showPosTag) ([(LineOffset, Tag)] -> Text) -> [(LineOffset, Tag)] -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\x7f" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x01" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
showInt Int
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
showInt Int
offset Text -> Text -> Text
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 (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
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 (String -> [String]) -> IO String -> IO [String]
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 [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                            else do
                                   -- filter . .. and hidden files .*
                                   [String]
contents <- ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
'.' (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head))
                                                    (String -> IO [String]
SD.getDirectoryContents String
p)
                                   [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO [String]
go (String -> IO [String]) -> ShowS -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
(</>) String
p) [String]
contents
                     else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
p | Bool
matchingSuffix Bool -> Bool -> Bool
|| String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
path]
               where matchingSuffix :: Bool
matchingSuffix = Bool -> ([String] -> Bool) -> Maybe [String] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
p)) Maybe [String]
suffixes
                     isSymLink :: IO Bool
isSymLink = String -> IO Bool
SD.pathIsSymbolicLink String
p