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

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

    module Dhall.Tags
        ( generate
        ) where

    import Control.Exception (handle, SomeException(..))
    import Data.List (isSuffixOf, foldl')
    import Data.Maybe (fromMaybe)
    import Data.Semigroup (Semigroup(..))
    import Dhall.Map (foldMapWithKey)
    import Data.Text (Text)
    import Data.Text.Encoding (encodeUtf8)
    import Dhall.Util (Input(..))
    import Dhall.Syntax (Expr(..), Binding(..))
    import Dhall.Src (Src(srcStart))
    import Dhall.Parser (exprFromText)
    import System.FilePath ((</>), takeFileName)
    import Text.Megaparsec (sourceLine, sourceColumn, 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 ts1 :: Map String [(LineOffset, Tag)]
    ts1) <> :: Tags -> Tags -> Tags
    <> (Tags ts2 :: 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
        mappend :: Tags -> Tags -> Tags
    mappend = Tags -> Tags -> Tags
    forall a. Semigroup a => a -> a -> a
    (<>)

    {-| 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 inp :: Input
    inp sxs :: Maybe [Text]
    sxs followSyms :: 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 (\f :: String
    f -> (SomeException -> IO Tags) -> IO Tags -> IO Tags
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle (\(SomeException _) -> 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 f :: String
    f t :: 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 1 1, Text -> Text -> Tag
    Tag "" (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 1 1, Text -> Text -> Tag
    Tag "" ("/" 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 t :: Text
    t = case String -> Text -> Either ParseError (Expr Src Import)
    exprFromText "" Text
    t of
        Right expr :: 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)
        _ -> [(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 t :: 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 ln :: Int
    ln c :: Int
    c, term :: Text
    term) ->
                 let (ln' :: Int
    ln', offset :: Int
    offset, tPattern :: 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 ([], 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 [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 (numberedLinesWithSizes :: [(Int, (Text, Int))]
    numberedLinesWithSizes, bytesBeforeLine :: Int
    bytesBeforeLine) (n :: Int
    n, line :: 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
    + 1

              lineFromMap :: Int -> (Text, Int)
    lineFromMap ln :: Int
    ln = (Text, Int) -> Maybe (Text, Int) -> (Text, Int)
    forall a. a -> Maybe a -> a
    fromMaybe ("", 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 term :: Text
    term ln :: Int
    ln
                  | Int
    ln Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 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
    - 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
    + 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 (l :: Text
    l, lsl :: Int
    lsl) = Int -> (Text, Int)
    lineFromMap Int
    ln
                        (part1 :: Text
    part1, part2 :: 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
    + 1) Text
    part2

              fallbackInfoForText :: Int -> Int -> (Int, Int, Text)
    fallbackInfoForText ln :: Int
    ln c :: Int
    c = (Int
    ln, Int
    lsl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Text -> Int
    lengthInBytes Text
    pat, Text
    pat)
                  where (l :: Text
    l, lsl :: 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 0 0) []
        where go :: LineColumn
    -> [(LineColumn, Text)] -> Expr Src a -> [(LineColumn, Text)]
    go lpos :: LineColumn
    lpos mts :: [(LineColumn, Text)]
    mts = \case
                  (Let b :: Binding Src a
    b e :: 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 e1 :: Expr Src a
    e1 e2 :: 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 mr :: Map Text (Expr 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 Map Text (Expr Src a)
    mr
                  (RecordLit mr :: Map Text (Expr 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 Map Text (Expr Src a)
    mr
                  (Union mmr :: 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 s :: Src
    s e :: 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
                  _ -> [(LineColumn, Text)]
    mts

              tagsFromDhallMap :: LineColumn -> Map Text (Expr Src a) -> [(LineColumn, Text)]
    tagsFromDhallMap lpos :: 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 lpos :: 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 (\k :: Text
    k -> \case
                  Just e :: Expr Src a
    e -> LineColumn -> Text -> Expr Src a -> [(LineColumn, Text)]
    tagsFromDhallMapElement LineColumn
    lpos Text
    k Expr Src a
    e
                  _ -> [(LineColumn
    lpos, Text
    k)])

              tagsFromDhallMapElement :: LineColumn -> Text -> Expr Src a -> [(LineColumn, Text)]
    tagsFromDhallMapElement lpos :: LineColumn
    lpos k :: Text
    k e :: 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 lpos :: LineColumn
    lpos b :: 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 src :: Maybe Src
    src startPos :: 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 s :: 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 lpos :: LineColumn
    lpos = \case
        (Note s :: Src
    s _) -> Src -> LineColumn
    srcToLineColumn Src
    s
        _ -> LineColumn
    lpos

    showTags :: Tags -> Text
    showTags :: Tags -> Text
    showTags (Tags ts :: 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 f :: String
    f ts :: [(LineOffset, Tag)]
    ts = "\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
    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
    <> "\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 lo :: LineOffset
    lo tag :: Tag
    tag = Text
    def Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>"\x7f" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "\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
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    showInt Int
    offset Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "\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 _ _ 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 followSyms :: Bool
    followSyms suffixes :: Maybe [String]
    suffixes (InputFile path :: String
    path) = String -> IO [String]
    go String
    path
        where go :: String -> IO [String]
    go p :: 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 -> 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