Skip to content
Snippets Groups Projects
Select Git revision
  • d31c8af61fbdcf44f566f18a72cd947fc87b5f16
  • master default protected
  • fix-6.13.0
  • 6.7.0-fix
  • bookworm
  • 6.4.4-oauth-fix
  • meteor-fix
  • patch-support
  • 7.8.0 protected
  • 7.3.6 protected
  • 7.4.4 protected
  • 7.5.3 protected
  • 7.6.4 protected
  • 7.7.4 protected
  • 7.7.3 protected
  • 7.7.2 protected
  • 7.7.1 protected
  • 7.1.6 protected
  • 7.2.6 protected
  • 7.3.5 protected
  • 7.4.3 protected
  • 7.5.2 protected
  • 7.6.3 protected
  • 7.6.2 protected
  • 7.7.0 protected
  • 7.6.1 protected
  • 7.6.0 protected
  • 7.5.1 protected
28 results

README.md

Blame
  • Substitute.hs 3.69 KiB
    {-# 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)