cars.hs

{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

import GHC.OverloadedLabels
import GHC.TypeLits
import Data.Proxy
import GHC.Records

x :: Char
x = #car "asdf"
-- > x
-- 'a'

y :: Char
y = #cadr "asdf"
-- > y
-- 's'

u :: Integer
u = [1,2,3].car
-- > u
-- 1

v :: Integer
v = [1,2,3].caddr
-- > v
-- 3

-- x.y desugars to getField @"y" x
instance KnownSymbol str => HasField str [a] a where
  getField :: KnownSymbol str => [a] -> a
  getField = ixstr @str

-- #x desugars to fromLabel @"x"
instance KnownSymbol str => IsLabel str ([a] -> a) where
  fromLabel :: KnownSymbol str => [a] -> a
  fromLabel = ixstr @str

ixstr :: forall str a. KnownSymbol str => [a] -> a
ixstr xs =
  let str = symbolVal $ Proxy @str
  in
  case str of
    ('c':str) | last str == 'r' ->
      head $ drop (length $ filter (=='d') str) xs
    _ -> error $ "variable " ++ str ++ " is not bound"