summaryrefslogtreecommitdiff
path: root/src/Hakyll/Error.hs
blob: 3ca29d3f6279c7ddc6fa5d1686fcaba66b6faf01 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
module Hakyll.Error
    ( ErrorConv (..)
    , throwErr
    , CompilerError
    ) where

import Prolog
import Text.Parsec.Error

class ErrorConv c err where
    toErr :: c -> err

type CompilerError c = ErrorConv c [String]

instance ErrorCnv err err where
    toErr = id

-- instance Functor f => ErrorCnv c err => ErrorCnv (f c) (f err) where
--     toErr = fmap toErr

instance Applicative f => ErrorCnv c err => ErrorCnv c (f err) where
    toErr = pure . toErr

throwErr :: (MonadError err m, ErrorConv c err) => c -> m a
throwErr = throwError . toErr

liftErr :: (MonadError err m, ErrorConv c err) => Either c a -> m a
liftErr = either throwErr pure

squashErr :: (MonadError err m, ErrorConv c err) => m (Either c a) -> m a
squashErr = (>>= liftErr)

instance ErrorConv Message String where
    toErr = messageString

instance ErrorConv ParseError [String] where
    toErr = fmap messageString . errorMessages


-- class CompilerError c where
--     toCompilerError :: c -> [String]
--     default toCompilerError :: Exception c => c -> [String]
--     toCompilerError = pure . displayException

--     toCompilerErrors :: [c] -> [String]
--     toCompilerErrors = (>>= toCompilerError)

-- instance CompilerError c => CompilerError [c] where
--     toCompilerError = toCompilerErrors


-- throwCompilerError :: (MonadError [String] m, CompilerError c) => c -> m a
-- throwCompilerError = throwError . toCompilerError

-- liftCompilerError :: (MonadError [String] m, CompilerError c) => Either c a -> m a
-- liftCompilerError = either throwError pure

-- squashCompilerError :: (MonadError [String] m, CompilerError c) => m (Either c a) -> m a
-- squashCompilerError = (>>= liftCompilerError)

-- instance CompilerError Char where
--     toCompilerError = pure . pure
--     toCompilerErrors = pure

-- instance CompilerError Message where
--     toCompilerError = pure . messageString
--     toCompilerErrors = fmap messageString

-- instance CompilerError ParseError where
--     toCompilerError = toCompilerErrors . errorMessages