Dot.hs

{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses, PolyKinds, ScopedTypeVariables, TypeApplications #-}

module Dot where

import Control.Category (Category, (>>>))
import qualified Control.Category as C
import GHC.Records
import GHC.Types

class IsField (x :: Symbol) a where
    fromField :: a

instance HasField x r a => IsField x (r -> a) where
    fromField = getField @x

class HasField x r a => SetField (x :: k) r a where
    updateField :: (a -> a) -> r -> r

newtype Setter r a = Setter ((a -> a) -> r -> r)

instance SetField x r a => IsField x (Setter r a) where
    fromField = Setter $ updateField @x

instance Category Setter where
    Setter f . Setter g = Setter (g . f)
    id = Setter id

(.~) :: Setter r a -> a -> r -> r
Setter f .~ x = f $ const x
infixr 4 .~

----

ex1 :: IsField "foo" a => a
ex1 = fromField @"foo"
--  = .foo

ex2 :: HasField "foo" r a => r -> a
ex2 = \x -> fromField @"foo" x
--  = \x -> x.foo

ex3 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
ex3 = fromField @"bar" . fromField @"foo"
--  = .foo.bar  (a)

ex4 :: (IsField "foo" (cat a b), IsField "bar" (cat b c), Category cat) => cat a c
ex4 = fromField @"foo" >>> fromField @"bar"
--  = .foo.bar  (b)

ex5 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
ex5 = \x -> fromField @"bar" $ fromField @"foo" x
--  = \x -> x.foo.bar

ex6 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
ex6 = \x -> fromField @"bar" . fromField @"foo" $ x
--  = \x -> .foo.bar x  (a)

ex7 :: (HasField "foo" a b, HasField "bar" b c) => a -> c
ex7 = \x -> fromField @"foo" >>> fromField @"bar" $ x
--  = \x -> .foo.bar x  (b)

ex8 :: (Num a, SetField "foo" r a) => r -> r
ex8 = fromField @"foo" .~ 5
--  = .foo .~ 5

ex9 :: (Num a, SetField "foo" r b, SetField "bar" b a) => r -> r
ex9 = (fromField @"foo" >>> fromField @"bar") .~ 5
--  = .foo.bar .~ 5  (b)