-- | Utilites for result types and error throwing
module L3.Util.Util
  ( Error (..),
    Result (..),
    showIndent,
    throw,
    throwError,
    rethrowError,
    unpack,
    mapL,
    mapR,
    fmapR,
    flatten,
    throwL,
    isError,
  )
where

import Data.Char (isSpace)

newtype Error = Error ([String], Maybe Error)
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq)

instance Show Error where
  show :: Error -> String
show = Int -> Error -> String
show' Int
0
    where
      show' :: Int -> Error -> String
      show' :: Int -> Error -> String
show' Int
i (Error ([String]
errs, Maybe Error
cause)) = (String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trimR ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> String
forall p. p -> [String] -> String
showErrors Int
i [String]
errs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> Maybe Error -> [String]
showCause Int
i Maybe Error
cause
      showErrors :: p -> [String] -> String
showErrors p
i [String]
errs = ShowS
trimR ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (p -> ShowS
forall p. p -> ShowS
indent p
i) [String]
errs
      indent :: p -> ShowS
indent p
i = ShowS
trimR ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
1 String
"\t" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ShowS
trimR String
l]) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
      showCause :: Int -> Maybe Error -> [String]
showCause Int
i Maybe Error
cause = case Maybe Error
cause of
        Just Error
c -> [Int -> Error -> String
show' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Error
c]
        Maybe Error
Nothing -> []
      trim :: ShowS
trim = ShowS
trimL ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trimR
      trimR :: ShowS
trimR = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trimL ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
      trimL :: ShowS
trimL = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

type Result a = Either Error a

showIndent :: (Show a) => a -> String
showIndent :: a -> String
showIndent = (String
"| " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

throw :: Error -> Result a
throw :: Error -> Result a
throw = Error -> Result a
forall a b. a -> Either a b
Left

throwError :: [String] -> Error
throwError :: [String] -> Error
throwError [String]
errs = ([String], Maybe Error) -> Error
Error ([String]
errs, Maybe Error
forall a. Maybe a
Nothing)

rethrowError :: [String] -> Error -> Error
rethrowError :: [String] -> Error -> Error
rethrowError [String]
errs Error
cause = ([String], Maybe Error) -> Error
Error ([String]
errs, Error -> Maybe Error
forall a. a -> Maybe a
Just Error
cause)

unpack :: [Result a] -> Result [a]
unpack :: [Result a] -> Result [a]
unpack (Left Error
err : [Result a]
_) = Error -> Result [a]
forall a. Error -> Result a
throw Error
err
unpack (Right a
r : [Result a]
rs) = case [Result a] -> Result [a]
forall a. [Result a] -> Result [a]
unpack [Result a]
rs of
  Left Error
err -> Error -> Result [a]
forall a. Error -> Result a
throw Error
err
  Right [a]
rs' -> [a] -> Result [a]
forall a b. b -> Either a b
Right (a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs')
unpack [] = [a] -> Result [a]
forall a b. b -> Either a b
Right []

mapL :: (Error -> Error) -> Result a -> Result a
mapL :: (Error -> Error) -> Result a -> Result a
mapL Error -> Error
f (Left Error
err) = Error -> Result a
forall a b. a -> Either a b
Left (Error -> Result a) -> Error -> Result a
forall a b. (a -> b) -> a -> b
$ Error -> Error
f Error
err
mapL Error -> Error
_ (Right a
res) = a -> Result a
forall a b. b -> Either a b
Right a
res

mapR :: (a -> b) -> Result a -> Result b
mapR :: (a -> b) -> Result a -> Result b
mapR a -> b
_ (Left Error
err) = Error -> Result b
forall a b. a -> Either a b
Left Error
err
mapR a -> b
f (Right a
res) = b -> Result b
forall a b. b -> Either a b
Right (b -> Result b) -> b -> Result b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
res

fmapR :: (a -> Result b) -> Result a -> Result b
fmapR :: (a -> Result b) -> Result a -> Result b
fmapR a -> Result b
_ (Left Error
err) = Error -> Result b
forall a b. a -> Either a b
Left Error
err
fmapR a -> Result b
f (Right a
res) = a -> Result b
f a
res

flatten :: Result (Result a) -> Result a
flatten :: Result (Result a) -> Result a
flatten (Left Error
err) = Error -> Result a
forall a b. a -> Either a b
Left Error
err
flatten (Right (Left Error
err)) = Error -> Result a
forall a b. a -> Either a b
Left Error
err
flatten (Right (Right a
res)) = a -> Result a
forall a b. b -> Either a b
Right a
res

throwL :: Result a -> a
throwL :: Result a -> a
throwL (Left Error
err) = String -> a
forall a. HasCallStack => String -> a
Prelude.error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
throwL (Right a
res) = a
res

isError :: Result a -> Bool
isError :: Result a -> Bool
isError (Left Error
_) = Bool
True
isError (Right a
_) = Bool
False