Pour monsieur Charvet

bot.hs

{-# OPTIONS_GHC -Wall -Wextra #-}

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

import Data.Functor.Product (Product (..))
import Data.Barbie
import Data.Generic.HKD
import Data.Kind (Type)
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Text.Printf (printf)

type SomeTimeZone = ()

-- So, there are a few ways of approaching this. The first way is the "bag
-- approach", using a package like @dependent-map@:

data Key (value :: Type) where
  UserTimezone :: Key SomeTimeZone
  UserDoB :: Key (Int, Int, Int)

type Settings = DMap Key Maybe -- @Maybe@ for missing/defaults.

-- Inserting / retrieving and even interpreting: they're already defined!
interpret :: Applicative f => (forall x. Key x -> Maybe x -> f ()) -> Settings -> f ()
interpret = DMap.traverseWithKey_

-- The forall there is potentially misleading: you just pattern-match on all
-- the keys in the GADT.
example :: Settings -> IO ()
example = interpret \key value ->
  case key of
    UserTimezone -> -- GHC learns that value :: SomeTimeZone
      case value of
        Just () -> putStrLn "Timezone!"
        Nothing -> putStrLn "No timezone!"

    UserDoB -> do -- GHC learns that value :: (Int, Int, Int)
      case value of
        Just (y, m, d) -> putStrLn (printf "Birthday: %d/%d/%d" d m y)
        Nothing -> putStrLn "No birthday!"

-------------------

-- Alternatively, Higgledy gives you a more generic-friendly approach:

data User
  = User
      { dob :: (Int, Int, Int)
      , timezone :: SomeTimeZone
      }

-- You can make an interpreter like this:
newtype Process (m :: Type -> Type) (x :: Type)
  = Process (x -> m ())

-- Set up the different types like this:
type Preferences = HKD User Maybe
type Interpreter m = HKD User (Process m)

interpret_
  :: ( Applicative m
     , ProductB (HKD User)
     , TraversableB (HKD User)
     )
  => Preferences -> Interpreter m -> m ()
interpret_ settings = btraverse_ go . bprod settings
  where
    go (Pair value (Process f))
      = case value of
          Just x -> f x
          Nothing -> pure ()

-- In this case? I think I prefer the first one :)