{-# LANGUAGE TupleSections #-}

{-
    Copyright (C) 2021-2022 Red Hat, Inc.

    This file is part of defloc.

    defloc is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    defloc is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

module Defloc (findFuncTokenIds, main, parse, processFiles, processReport) where

import ShellCheck.AST
import ShellCheck.Interface
import ShellCheck.Parser

import Control.Monad (when)

import Data.Functor.Identity (runIdentity)
import Data.Maybe (fromJust, isNothing)

import qualified Data.Map  as M

import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr)

import Text.Regex.PCRE ((=~))


findFuncTokenIds :: String -> Token -> [(Id, String)]
findFuncTokenIds :: String -> Token -> [(Id, String)]
findFuncTokenIds String
func (OuterToken Id
tokID InnerToken Token
it) = case InnerToken Token
it of
    Inner_TA_Binary String
_ Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_TA_Assignment String
_ Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_TA_Variable String
_ [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_TA_Expansion [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_TA_Sequence [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_TA_Trinary Token
t1 Token
t2 Token
t3 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t3
    Inner_TA_Unary String
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_TC_And ConditionType
_ String
_ Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_TC_Binary ConditionType
_ String
_ Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_TC_Group ConditionType
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_TC_Nullary ConditionType
_ Token
t  -> Token -> [(Id, String)]
ff Token
t
    Inner_TC_Or ConditionType
_ String
_ Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_TC_Unary ConditionType
_ String
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_TC_Empty ConditionType
_ -> []
    InnerToken Token
Inner_T_AND_IF -> []
    Inner_T_AndIf Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_T_Arithmetic Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_Array [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_IndexedElement [Token]
ts Token
t -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t
    Inner_T_UnparsedIndex SourcePos
_ String
_ -> []
    Inner_T_Assignment AssignmentMode
_ String
_ [Token]
ts Token
t -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t
    Inner_T_Backgrounded Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_Backticked [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_Bang -> []
    Inner_T_Banged Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_BraceExpansion [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_BraceGroup [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_CLOBBER -> []
    InnerToken Token
Inner_T_Case -> []
    Inner_T_CaseExpression Token
t [(CaseType, [Token], [Token])]
ts -> Token -> [(Id, String)]
ff Token
t [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++
        ((CaseType, [Token], [Token]) -> [(Id, String)])
-> [(CaseType, [Token], [Token])] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(CaseType
_, [Token]
ts1, [Token]
ts2) -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2) [(CaseType, [Token], [Token])]
ts
    Inner_T_Condition ConditionType
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    InnerToken Token
Inner_T_DGREAT -> []
    InnerToken Token
Inner_T_DLESS -> []
    InnerToken Token
Inner_T_DLESSDASH -> []
    InnerToken Token
Inner_T_DSEMI -> []
    InnerToken Token
Inner_T_Do -> []
    Inner_T_DollarArithmetic Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_DollarBraced Bool
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_DollarBracket Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_DollarDoubleQuoted [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_DollarExpansion [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_DollarSingleQuoted String
_ -> []
    Inner_T_DollarBraceCommandExpansion [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_Done -> []
    Inner_T_DoubleQuoted [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_EOF -> []
    InnerToken Token
Inner_T_Elif -> []
    InnerToken Token
Inner_T_Else -> []
    InnerToken Token
Inner_T_Esac -> []
    Inner_T_Extglob String
_ [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_FdRedirect String
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    InnerToken Token
Inner_T_Fi -> []
    InnerToken Token
Inner_T_For -> []
    Inner_T_ForArithmetic Token
t1 Token
t2 Token
t3 [Token]
ts -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t3 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++
        (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_ForIn String
_ [Token]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2
    Inner_T_Function FunctionKeyword
_ FunctionParentheses
_ String
name Token
t -> if String
name String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
func
                                      then (Id
tokID, String
name) (Id, String) -> [(Id, String)] -> [(Id, String)]
forall a. a -> [a] -> [a]
: Token -> [(Id, String)]
ff Token
t
                                      else Token -> [(Id, String)]
ff Token
t
    InnerToken Token
Inner_T_GREATAND -> []
    Inner_T_Glob String
_ -> []
    InnerToken Token
Inner_T_Greater -> []
    Inner_T_HereDoc Dashed
_ Quoted
_ String
_ [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    Inner_T_HereString Token
t -> Token -> [(Id, String)]
ff Token
t
    InnerToken Token
Inner_T_If -> []
    Inner_T_IfExpression [([Token], [Token])]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++
        (([Token], [Token]) -> [(Id, String)])
-> [([Token], [Token])] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Token]
ts3, [Token]
ts4) -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts3 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts4) [([Token], [Token])]
ts1
    InnerToken Token
Inner_T_In -> []
    Inner_T_IoFile Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_T_IoDuplicate Token
t String
_ -> Token -> [(Id, String)]
ff Token
t
    InnerToken Token
Inner_T_LESSAND -> []
    InnerToken Token
Inner_T_LESSGREAT -> []
    InnerToken Token
Inner_T_Lbrace -> []
    InnerToken Token
Inner_T_Less -> []
    Inner_T_Literal String
_ -> []
    InnerToken Token
Inner_T_Lparen -> []
    InnerToken Token
Inner_T_NEWLINE -> []
    Inner_T_NormalWord [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_OR_IF -> []
    Inner_T_OrIf Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_T_ParamSubSpecialChar String
_ -> []
    Inner_T_Pipeline [Token]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2
    Inner_T_ProcSub String
_ [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_Rbrace -> []
    Inner_T_Redirecting [Token]
ts Token
t -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t
    InnerToken Token
Inner_T_Rparen -> []
    Inner_T_Script Token
t [Token]
ts -> Token -> [(Id, String)]
ff Token
t [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_Select -> []
    Inner_T_SelectIn String
_ [Token]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2
    InnerToken Token
Inner_T_Semi -> []
    Inner_T_SimpleCommand [Token]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2
    Inner_T_SingleQuoted String
_ -> []
    Inner_T_Subshell [Token]
ts -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts
    InnerToken Token
Inner_T_Then -> []
    InnerToken Token
Inner_T_Until -> []
    Inner_T_UntilExpression [Token]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2
    InnerToken Token
Inner_T_While -> []
    Inner_T_WhileExpression [Token]
ts1 [Token]
ts2 -> (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ (Token -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [(Id, String)]
ff [Token]
ts2
    Inner_T_Annotation [Annotation]
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_Pipe String
_ -> []
    Inner_T_CoProc Maybe String
_ Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_CoProcBody Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_Include Token
t -> Token -> [(Id, String)]
ff Token
t
    Inner_T_SourceCommand Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    Inner_T_BatsTest Token
t1 Token
t2 -> Token -> [(Id, String)]
ff Token
t1 [(Id, String)] -> [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a] -> [a]
++ Token -> [(Id, String)]
ff Token
t2
    where ff :: Token -> [(Id, String)]
ff = String -> Token -> [(Id, String)]
findFuncTokenIds String
func


processReport :: String -> (FilePath, ParseResult) -> Either String [String]
processReport :: String -> (String, ParseResult) -> Either String [String]
processReport String
func (String
file, ParseResult
result) = do
    -- ShellCheck does not export the ParseResult data constructor
    let root :: Maybe Token
root = ParseResult -> Maybe Token
prRoot ParseResult
result

    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Token -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Token
root) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Parsing failed (no AST generated)"

    let ids :: [(Id, String)]
ids = String -> Token -> [(Id, String)]
findFuncTokenIds String
func (Token -> [(Id, String)]) -> Token -> [(Id, String)]
forall a b. (a -> b) -> a -> b
$ Maybe Token -> Token
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Token
root
    [String] -> Either String [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Either String [String])
-> [String] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ (Id, String) -> String
getLoc ((Id, String) -> String) -> [(Id, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Id, String)]
ids
        where getLoc :: (Id, String) -> String
getLoc (Id
i, String
f) = String -> (Position, Position) -> String
strPos String
f ((Position, Position) -> String) -> (Position, Position) -> String
forall a b. (a -> b) -> a -> b
$ Maybe (Position, Position) -> (Position, Position)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Position, Position) -> (Position, Position))
-> Maybe (Position, Position) -> (Position, Position)
forall a b. (a -> b) -> a -> b
$ Id -> Map Id (Position, Position) -> Maybe (Position, Position)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
i (Map Id (Position, Position) -> Maybe (Position, Position))
-> Map Id (Position, Position) -> Maybe (Position, Position)
forall a b. (a -> b) -> a -> b
$ ParseResult -> Map Id (Position, Position)
prTokenPositions ParseResult
result
              strPos :: String -> (Position, Position) -> String
strPos String
f (Position
from, Position
to) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Position -> String
posFile Position
from, String
":", String
f, String
":",
                                            Position -> String
strLoc Position
from, String
"-", Position -> String
strLoc Position
to]
              strLoc :: Position -> String
strLoc Position
pos          = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Integer -> String
forall a. Show a => a -> String
show (Position -> Integer
posLine Position
pos), String
":",
                                    Integer -> String
forall a. Show a => a -> String
show (Position -> Integer
posColumn Position
pos)]


parse :: (FilePath, String) -> (FilePath, ParseResult)
parse :: (String, String) -> (String, ParseResult)
parse (String
file, String
contents) = (String
file, Identity ParseResult -> ParseResult
forall a. Identity a -> a
runIdentity (Identity ParseResult -> ParseResult)
-> Identity ParseResult -> ParseResult
forall a b. (a -> b) -> a -> b
$ SystemInterface Identity -> ParseSpec -> Identity ParseResult
forall (m :: * -> *).
Monad m =>
SystemInterface m -> ParseSpec -> m ParseResult
parseScript SystemInterface Identity
intf ParseSpec
spec)
    where intf :: SystemInterface Identity
intf = [(String, String)] -> SystemInterface Identity
mockedSystemInterface []
          spec :: ParseSpec
spec = ParseSpec
newParseSpec { psFilename :: String
psFilename = String
file,
                                psScript :: String
psScript   = String
contents }


processFiles :: String -> [(FilePath, String)] -> IO ()
processFiles :: String -> [(String, String)] -> IO ()
processFiles String
func = ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String) -> IO ()
process
    where process :: (String, String) -> IO ()
process (String, String)
x = Either String [String] -> IO ()
handle (Either String [String] -> IO ())
-> Either String [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (String, ParseResult) -> Either String [String]
processReport String
func ((String, ParseResult) -> Either String [String])
-> (String, ParseResult) -> Either String [String]
forall a b. (a -> b) -> a -> b
$ (String, String) -> (String, ParseResult)
parse (String, String)
x

          handle :: Either String [String] -> IO ()
          handle :: Either String [String] -> IO ()
handle (Left  String
e)  = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
e
          handle (Right [String]
xs) = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
xs


-- Argument parsing
processOpts :: [String] -> IO (String, [FilePath])
processOpts :: [String] -> IO (String, [String])
processOpts (String
func:scripts :: [String]
scripts@(String
_:[String]
_)) = (String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
func, [String]
scripts)
processOpts [String]
_ = IOError -> IO (String, [String])
forall a. IOError -> IO a
ioError (IOError -> IO (String, [String]))
-> IOError -> IO (String, [String])
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"Incorrect number of arguments.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      String
"USAGE: defloc FUNCTION [SCRIPTS]\n"


main :: IO ()
main :: IO ()
main = do
    (String
func, [String]
scripts) <- IO [String]
getArgs IO [String]
-> ([String] -> IO (String, [String])) -> IO (String, [String])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO (String, [String])
processOpts
    (String -> IO (String, String))
-> [String] -> IO [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, String)
readWithName [String]
scripts IO [(String, String)] -> ([(String, String)] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> [(String, String)] -> IO ()
processFiles String
func
    where readWithName :: String -> IO (String, String)
readWithName String
x = (String
x,) (String -> (String, String)) -> IO String -> IO (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
x