SHARE
TWEET

Dot.hs

Tysonzero Nov 16th, 2019 (edited) 148 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances #-}
  2. {-# LANGUAGE MultiParamTypeClasses, PolyKinds, ScopedTypeVariables, TypeApplications #-}
  3.  
  4. module Dot where
  5.  
  6. import Control.Category (Category, (>>>))
  7. import qualified Control.Category as C
  8. import GHC.Records
  9. import GHC.Types
  10.  
  11. class IsField (x :: Symbol) a where
  12.     fromField :: a
  13.  
  14. instance HasField x r a => IsField x (r -> a) where
  15.     fromField = getField @x
  16.  
  17. class HasField x r a => SetField (x :: k) r a where
  18.     updateField :: (a -> a) -> r -> r
  19.  
  20. newtype Setter r a = Setter ((a -> a) -> r -> r)
  21.  
  22. instance SetField x r a => IsField x (Setter r a) where
  23.     fromField = Setter $ updateField @x
  24.  
  25. instance Category Setter where
  26.     Setter f . Setter g = Setter (g . f)
  27.     id = Setter id
  28.  
  29. (.~) :: Setter r a -> a -> r -> r
  30. Setter f .~ x = f $ const x
  31. infixr 4 .~
  32.  
  33. ----
  34.  
  35. ex1 :: IsField "foo" a => a
  36. ex1 = fromField @"foo"
  37. --  = .foo
  38.  
  39. ex2 :: HasField "foo" r a => r -> a
  40. ex2 = \x -> fromField @"foo" x
  41. --  = \x -> x.foo
  42.  
  43. ex3 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
  44. ex3 = fromField @"bar" . fromField @"foo"
  45. --  = .foo.bar  (a)
  46.  
  47. ex4 :: (IsField "foo" (cat a b), IsField "bar" (cat b c), Category cat) => cat a c
  48. ex4 = fromField @"foo" >>> fromField @"bar"
  49. --  = .foo.bar  (b)
  50.  
  51. ex5 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
  52. ex5 = \x -> fromField @"bar" $ fromField @"foo" x
  53. --  = \x -> x.foo.bar
  54.  
  55. ex6 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
  56. ex6 = \x -> fromField @"bar" . fromField @"foo" $ x
  57. --  = \x -> .foo.bar x  (a)
  58.  
  59. ex7 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
  60. ex7 = \x -> fromField @"foo" >>> fromField @"bar" $ x
  61. --  = \x -> .foo.bar x  (b)
  62.  
  63. ex8 :: (Num a, SetField "foo" r a) => r -> r
  64. ex8 = fromField @"foo" .~ 5
  65. --  = .foo .~ 5
  66.  
  67. ex9 :: (Num a, SetField "foo" r b, SetField "bar" b a) => r -> r
  68. ex9 = (fromField @"foo" >>> fromField @"bar") .~ 5
  69. --  = .foo.bar .~ 5  (b)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top