decode-with-runtime-key.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

import Data.Aeson (FromJSON (..), decode, withObject, (.:))
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import GHC.TypeLits (KnownSymbol, SomeSymbol (..), Symbol, someSymbolVal, symbolVal)

data X = X {value :: Int}
  deriving stock (Show)

newtype XWithKey (key :: Symbol) = XWithKey X

instance KnownSymbol key => FromJSON (XWithKey key) where
  parseJSON = withObject "X" \v -> do
    value <- v .: fromString (symbolVal (Proxy :: Proxy key))
    pure (XWithKey X {value})

main :: IO ()
main = do
  key <- fetchKeyFromJIRA
  SomeSymbol (Proxy :: Proxy key) <- pure (someSymbolVal key)
  XWithKey x <- fetchX @key
  print x
  where
    fetchKeyFromJIRA :: IO String
    fetchKeyFromJIRA = pure "hello"

    fetchX :: KnownSymbol key => IO (XWithKey key)
    fetchX =
      case decode (fromString "{\"hello\": 42}") of
        Just value -> pure value
        Nothing -> error "wtf"