Skip to content

Instantly share code, notes, and snippets.

@kana-sama

kana-sama/autowire.hs

Last active Oct 24, 2020
Embed
What would you like to do?
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
-- HList lib
data HList xs where
HNil :: HList '[]
(:-) :: x -> HList xs -> HList (x ': xs)
infixr 5 :-
class Project x xs where
project :: HList xs -> x
instance Project x (x : xs) where
project (x :- _) = x
instance {-# INCOHERENT #-} Project x (y : ys) => Project x (t : y : ys) where
project (_ :- xs) = project xs
-- Autowire
class Autowire result t xs | t -> result where
autowire :: t -> HList xs -> result
instance Autowire t t xs where
autowire t _ = t
instance (Autowire result t xs, Project x xs) => Autowire result (x -> t) xs where
autowire f xs = autowire (f (project xs)) xs
-- Example
main = do
putStrLn $ autowire f context
print $ (autowire g context :: Int)
putStrLn $ autowire h context
where
context :: HList [Int, String, Bool]
context = 42 :- "string" :- False :- HNil
f :: Bool -> Int -> String
f x y = show (x, y)
g :: String -> Int
g = length
h :: String
h = "simple"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.