some singletons

1.hs

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Aeson
import Data.Singletons
import Data.Singletons.TH

singletons [d|
  data AIIntent = IntentTask | IntentChart deriving (Show)
  |]

instance FromJSON (SAIIntent 'IntentTask) where
  parseJSON (String "create_task") = return SIntentTask
  parseJSON _ = fail "foo"

instance FromJSON (SAIIntent 'IntentChart) where
  parseJSON (String "create_chart") = return SIntentChart
  parseJSON _ = fail "Unknown action"

data SI = forall x . SI (Sing (x::AIIntent))

instance Show SI where
  show (SI SIntentTask) = "task"
  show (SI SIntentChart) = "chart"

instance FromJSON SI where
  parseJSON (String "create_task") = pure $ SI SIntentTask
  parseJSON (String "create_chart") = pure $ SI SIntentChart
  parseJSON _  = fail "Quu"

test = do
  print $ fromSing <$> (decode "\"create_task\"" :: Maybe (Sing 'IntentTask))
  print $ fromSing <$> (decode "\"create_chart\"" :: Maybe (Sing 'IntentTask))
  print $ fromSing <$> (decode "\"create_task\"" :: Maybe (Sing 'IntentChart))
  print $ fromSing <$> (decode "\"create_chart\"" :: Maybe (Sing 'IntentChart))
  print $ (decode "\"create_task\"" :: Maybe SI)
  print $ (decode "\"create_chart\"" :: Maybe SI)