{-# LANGUAGE CPP #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
-- | A few utility functions with improved error reporting.
module Data.ErrorOr.Utils (
  tryRead, Data.ErrorOr.Utils.lookup, lookupIn, OverloadedLookup(..)
) where

import qualified Data.Map as M
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Char

#if __GLASGOW_HASKELL__ < 880
import Prelude hiding (fail)
import Data.Semigroup
import Control.Monad.Fail (MonadFail(..))
#endif

-- | A class used to implement `lookup` and `lookupIn`.
class OverloadedLookup t k v | t -> k, t -> v where overloadedLookup :: k -> t -> Maybe v
instance Eq k => OverloadedLookup [(k,v)] k v where overloadedLookup :: k -> [(k, v)] -> Maybe v
overloadedLookup = k -> [(k, v)] -> Maybe v
forall k v. Eq k => k -> [(k, v)] -> Maybe v
List.lookup
instance Ord k => OverloadedLookup (M.Map k v) k v where overloadedLookup :: k -> Map k v -> Maybe v
overloadedLookup = k -> Map k v -> Maybe v
forall k v. Ord k => k -> Map k v -> Maybe v
M.lookup

-- | Overloaded lookup with good error messages.
lookup :: (OverloadedLookup t k v, Show k, Show t, MonadFail m, Applicative m) => k -> t -> m v
lookup :: k -> t -> m v
lookup k
k t
xs = Text -> k -> t -> m v
forall t k v (m :: * -> *).
(OverloadedLookup t k v, Show k, MonadFail m, Applicative m) =>
Text -> k -> t -> m v
lookupIn (Int -> Text -> Text
shorten Int
256 (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ t -> String
forall a. Show a => a -> String
show t
xs)) k
k t
xs

-- | This is a version of `lookup` for where there is no Show instance for the collection.
lookupIn :: (OverloadedLookup t k v, Show k, MonadFail m, Applicative m) => T.Text -> k -> t -> m v
lookupIn :: Text -> k -> t -> m v
lookupIn Text
name k
k =
  m v -> (v -> m v) -> Maybe v -> m v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m v) -> String -> m v
forall a b. (a -> b) -> a -> b
$ String
"Can't lookup " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> k -> String
forall a. Show a => a -> String
show k
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name) v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe v -> m v) -> (t -> Maybe v) -> t -> m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> t -> Maybe v
forall t k v. OverloadedLookup t k v => k -> t -> Maybe v
overloadedLookup k
k

shorten :: Int -> T.Text -> T.Text
shorten :: Int -> Text -> Text
shorten Int
maxLen Text
msg =
  case Int -> Text -> (Text, Text)
T.splitAt Int
maxLen Text
msg of
    (Text
x, Text
t) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
T.empty -> Text
x
    (Text
x, Text
_rest) -> Int -> Text -> Text
T.take (Int
maxLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(...)"

-- | A read with better error messages.
tryRead :: (Read a, Show a, MonadFail m) => String -> m a
tryRead :: String -> m a
tryRead String
str =
  case ReadS a
forall a. Read a => ReadS a
reads String
str of
    [] -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Can't read: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
shorten Int
256 String
str)
    [(a
a, String
rest)]
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Data.Char.isSpace String
rest -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    [(a, String)]
parses -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Ambiguous parse: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
shorten Int
256 ([(a, String)] -> String
forall a. Show a => a -> String
show [(a, String)]
parses))
  where
    shorten :: Int -> [Char] -> [Char]
    shorten :: Int -> String -> String
shorten Int
maxLen String
msg =
      case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
maxLen String
msg of
        (String
x, String
t) | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] -> String
x
        (String
x, String
_rest) -> Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
maxLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(...)"