Skip to content

Instantly share code, notes, and snippets.

@paolino
Last active August 27, 2020 07:59
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save paolino/04b861386c4932d1ff85048b780af61b to your computer and use it in GitHub Desktop.
how to apply a function on a record directly to its fields
{-# 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