{-
    Copyright 2022 Vidar Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck 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.

    ShellCheck 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 <https://www.gnu.org/licenses/>.
-}

-- Generic basic utility functions
module ShellCheck.Prelude where

import Data.Semigroup


-- Get element 0 or a default. Like `head` but safe.
headOrDefault :: a -> [a] -> a
headOrDefault a
_ (a
a:[a]
_) = a
a
headOrDefault a
def [a]
_   = a
def

-- Get the last element or a default. Like `last` but safe.
lastOrDefault :: p -> [p] -> p
lastOrDefault p
def [] = p
def
lastOrDefault p
_ [p]
list = [p] -> p
forall a. HasCallStack => [a] -> a
last [p]
list

--- Get element n of a list, or Nothing. Like `!!` but safe.
!!! :: [a] -> Int -> Maybe a
(!!!) [a]
list Int
i =
    case Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i [a]
list of
        []    -> Maybe a
forall a. Maybe a
Nothing
        (a
r:[a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
r


-- Like mconcat but for Semigroups
sconcat1 :: (Semigroup t) => [t] -> t
sconcat1 :: forall t. Semigroup t => [t] -> t
sconcat1 [t
x] = t
x
sconcat1 (t
x:[t]
xs) = t
x t -> t -> t
forall a. Semigroup a => a -> a -> a
<> [t] -> t
forall t. Semigroup t => [t] -> t
sconcat1 [t]
xs

sconcatOrDefault :: p -> [p] -> p
sconcatOrDefault p
def [] = p
def
sconcatOrDefault p
_ [p]
list = [p] -> p
forall t. Semigroup t => [t] -> t
sconcat1 [p]
list

-- For more actionable "impossible" errors
pleaseReport :: [Char] -> [Char]
pleaseReport [Char]
str = [Char]
"ShellCheck internal error, please report: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str