{-# 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)