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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Typeclasses for (generic) substitution on all strings contained in an ADT,
-- failsafe, but with error reporting
module Substitute (SubstitutionError, Substitutable(..)) where
import Universum
import qualified Data.Aeson as A
import qualified Data.Foldable as Fold
import Data.Tiled (GlobalId, LocalId)
import GHC.Generics (Generic (Rep, from, to), K1 (K1),
M1 (M1), U1, type (:*:) ((:*:)),
type (:+:) (..))
import qualified Text.Mustache as MU
import qualified Text.Mustache.Render as MU
import Text.Parsec.Error (ParseError)
-- | errors that might be encountered. SubstitutionErrors occur during substitution
-- and a generally non-fatal (but might result e.g. in empty strings being inserted
-- instead of variables), while CompileErrors may indicate that (invalid) template
-- syntax got leaked into the output
data SubstitutionError = CompileError ParseError | Mustache MU.SubstitutionError
deriving Show
class Substitutable s where
substitute :: s -> Map Text Text -> ([SubstitutionError], s)
instance Substitutable Text where
substitute orig substs = case MU.compileTemplate "" orig of
Right template -> first (map Mustache) $ MU.checkedSubstitute template substs
Left err -> ([CompileError err], orig) -- just ignore syntactic errors (TODO: add a log message?)
instance {-# OVERLAPS #-} Substitutable String where
substitute orig substs = second toString (substitute (toText orig) substs)
instance {-# OVERLAPPING #-} (Functor a, Substitutable b, Foldable a) => Substitutable (a b) where
substitute orig substs = (Fold.fold $ map fst orig',) $ map snd orig'
where orig' = map (`substitute` substs) orig
-- | helper: don't substitute anything, don't produce errors
trivial :: t -> b -> ([a], t)
trivial = const . ([],)
instance {-# OVERLAPS #-} Substitutable A.Value where
substitute (A.Object fields) params =
second A.Object $ traverse (`substitute` params) fields
substitute (A.String str) params =
second A.String $ substitute str params
substitute other params = ([], other)
instance Substitutable Int where
substitute = trivial
instance Substitutable GlobalId where
substitute = trivial
instance Substitutable LocalId where
substitute = trivial
instance Substitutable Double where
substitute = trivial
instance Substitutable Float where
substitute = trivial
class GSubstitutable i where
gsubstitute :: i p -> Map Text Text -> ([SubstitutionError], i p)
instance Substitutable c => GSubstitutable (K1 i c) where
gsubstitute (K1 text) = second K1 . substitute text
instance (GSubstitutable a, GSubstitutable b) => GSubstitutable (a :*: b) where
gsubstitute (a :*: b) substs = (e1 <> e2, a' :*: b')
where (e1, a') = gsubstitute a substs
(e2, b') = gsubstitute b substs
instance (GSubstitutable a, GSubstitutable b) => GSubstitutable (a :+: b) where
gsubstitute (L1 a) = second L1 . gsubstitute a
gsubstitute (R1 a) = second R1 . gsubstitute a
instance (GSubstitutable a) => GSubstitutable (M1 x y a) where
gsubstitute (M1 a) = second M1 . gsubstitute a
instance GSubstitutable U1 where
gsubstitute = trivial
instance {-# OVERLAPPABLE #-} (GSubstitutable (Rep a), Generic a) => Substitutable a where
substitute a substs = second to (gsubstitute (from a) substs)
|
