diff options
Diffstat (limited to '')
-rw-r--r-- | cwality-maps/Substitute.hs | 100 |
1 files changed, 0 insertions, 100 deletions
diff --git a/cwality-maps/Substitute.hs b/cwality-maps/Substitute.hs deleted file mode 100644 index ccab272..0000000 --- a/cwality-maps/Substitute.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# 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) |