Skip to content

Instantly share code, notes, and snippets.

@i-am-tom
Forked from geekingfrog/bot.hs
Last active July 9, 2020 11:59
Show Gist options
  • Save i-am-tom/0fb414ebc37dcbb3994b8a94634d5038 to your computer and use it in GitHub Desktop.
Save i-am-tom/0fb414ebc37dcbb3994b8a94634d5038 to your computer and use it in GitHub Desktop.
Pour monsieur Charvet
{-# 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 :)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment