Skip to content

Instantly share code, notes, and snippets.

@YuMingLiao
Created August 9, 2018 11:51
Show Gist options
  • Select an option

  • Save YuMingLiao/ae3cd447d01ff3facb899fa68db41e68 to your computer and use it in GitHub Desktop.

Select an option

Save YuMingLiao/ae3cd447d01ff3facb899fa68db41e68 to your computer and use it in GitHub Desktop.
Ex_RowToList.hs:104:11: error:
* The type [Char] does not contain a field named 'b'.
* In the second argument of `($)', namely
`pairwiseApply functions values'
In a stmt of a 'do' block: print $ pairwiseApply functions values
In the expression: do print $ pairwiseApply functions values
|
104 | print $ pairwiseApply functions values
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- design part
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-- usage part
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
import GHC.Generics
import Data.Proxy
import GHC.TypeLits
import Data.Generics.Product
class PairwiseApply
functions (functionsList :: [(Symbol, *)])
values (valuesList :: [(Symbol, *)])
where
pairwiseApplyImpl
:: Proxy functionsList
-> Proxy valuesList
-> functions
-> values
-> values
instance PairwiseApply functions '[] values '[] where
pairwiseApplyImpl _ _ _ x = x
instance
( HasField' name (val -> val) functions
, HasField' name val values
, PairwiseApply functions fnTail values valTail
) => PairwiseApply
functions (('(name, (val -> val))) ': fnTail)
values ('(name, val) ': valTail) where
pairwiseApplyImpl _ _ fns vals = do
setField @name (fn val) vals'
where
fn = getField @name fns
val = getField @name vals
vals' = pairwiseApplyImpl (Proxy @fnTail) (Proxy @valTail) fns vals
pairwiseApply :: forall vals fns valsL fnsL
. Generic fns
=> Generic vals
=> fnsL ~ GRowToList (Rep fns)
=> valsL ~ GRowToList (Rep vals)
=> PairwiseApply
fns fnsL
vals valsL
=> fns
-> vals
-> vals
pairwiseApply =
pairwiseApplyImpl
(Proxy @fnsL)
(Proxy @valsL)
type family GRowToList (r :: * -> *) :: [(Symbol, *)] where
GRowToList (l :*: r)
= GRowToList l ++ GRowToList r
GRowToList (S1 ('MetaSel ('Just name) _ _ _) (Rec0 a))
= '[ '(name, a) ]
GRowToList (M1 _ m a)
= GRowToList a
GRowToList U1 = '[]
type family (a :: [k]) ++ (b :: [k]) :: [k] where
'[] ++ bs = bs
(a ': as) ++ bs = a ': (as ++ bs)
--usage part
data Values = Values
{ a :: Int
, b :: String
} deriving (Generic, Show)
data Functions = Functions
{ a :: Int -> Int
, b :: String -> String
} deriving (Generic)
values :: Values
values = Values
{ a = 1
, b = "pen"
}
functions :: Functions
functions = Functions
{ a = (+) 1
, b = (++) "apple"
}
main :: IO ()
main = do
print $ pairwiseApply functions values
-- output:
-- Values {a = 2, b = "applepen"}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment