Created
August 9, 2018 11:51
-
-
Save YuMingLiao/ae3cd447d01ff3facb899fa68db41e68 to your computer and use it in GitHub Desktop.
This file contains hidden or 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
| 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 | |
| | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | |
This file contains hidden or 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
| -- 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