Last active
August 27, 2020 07:59
Star
You must be signed in to star a gist
how to apply a function on a record directly to its fields
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
-- needed for example | |
{-# LANGUAGE TemplateHaskell #-} | |
{-# LANGUAGE TypeApplications #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE UndecidableInstances #-} | |
import Generics.SOP | |
import Generics.SOP.TH -- needed for example | |
---------------- how to append to an NP I ------------------------ | |
type family Append x xs where | |
Append x '[] = '[x] | |
Append x (y : ys) = y : Append x ys | |
append :: x -> NP I xs -> NP I (Append x xs) | |
append x Nil = I x :* Nil | |
append x (y :* ys) = y :* append x ys | |
---------------- unroll a multiple argument function ------------------------ | |
{- | |
λ> type T = '[Text,Int] | |
λ> :kind! Result T () | |
Result T () :: * = Text -> Int -> () | |
-} | |
type family Result ys r where | |
Result '[] r = r | |
Result (y : ys) r = y -> Result ys r | |
---------------- how to curry a function on a record --------------------------- | |
class Curry r ys zs q where | |
curryNR | |
:: IsProductType r xs | |
=> Proxy r -- ^ record type | |
-> Proxy ys -- ^ remaining fields types | |
-> NP I zs -- ^ partial built record | |
-> (r -> q) -- ^ application from the record | |
-> Result ys q -- ^ currying on the fields | |
-- record fields are ready | |
instance | |
(IsProductType r xs) | |
=> Curry r '[] xs q | |
where | |
curryNR _t _ys zs f = f $ productTypeTo zs | |
-- get one more field | |
instance | |
( Curry r tys (Append hys zs) q | |
, IsProductType r xs | |
) | |
=> Curry r (hys : tys) zs q | |
where | |
curryNR r _ x f y = curryNR r (Proxy @tys) (append y x) f | |
-- | take an application on a record and curry it on the fields | |
curryRecord | |
:: forall r hxs txs xs q. | |
( (hxs : txs) ~ xs | |
, Curry r xs '[] q | |
, IsProductType r xs | |
) | |
=> (r -> q) | |
-> Result xs q | |
curryRecord = curryNR (Proxy @r) (Proxy @xs) Nil | |
---------------- example ------------------------ | |
data A = A Int String Char deriving (Show) | |
deriveGeneric ''A | |
fA :: A -> [Char] | |
fA (A n s c) = replicate n c <> s | |
test :: Bool | |
test = curryRecord fA 4 "ciao" 'c' == "ccccciao" | |
translate :: Int -> (Int, Int, Int) -> (Int, Int, Int) | |
translate d (x, y, z) = (x + d, y + d, z + d) | |
testTuple :: Bool | |
testTuple = curryRecord (translate 10) 1 2 3 == (11, 12, 13 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment