joshburgess · October 9, 2019 23:21 · Aug 4, 2016 · Aug 4, 2016 · Aug 4, 2016 · Aug 4, 2016
diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -9,6 +9,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
 
 -- | This module provides a way to name the fields in a regular
 -- Haskell tuple and then look them up later, statically.
@@ -32,15 +34,15 @@ instance (Show t) => Show (l := t) where
 -- We could add `set` to this, or just have a `lens` method
 -- which generates a lens for that field.
 class Has (l :: Symbol) r a | l r -> a where
-  get :: Proxy l -> r -> a
+  get :: r -> a
 
 -- Instances which we could easily generate with TH.
-instance Has l (l := a) a where get _ (_ := a) = a
-instance Has l ((l := a), u0) a where get _ ((_ := a),_) = a
-instance Has l (u0, (l := a)) a where get _ (_,(_ := a)) = a
-instance Has l ((l := a), u0, u1) a where get _ ((_ := a),_,_) = a
-instance Has l (u0, (l := a), u1) a where get _ (_,(_ := a),_) = a
-instance Has l (u0, u1, (l := a)) a where get _ (_,_,(_ := a)) = a
+instance Has l (l := a) a where get (_ := a) = a
+instance Has l ((l := a), u0) a where get ((_ := a),_) = a
+instance Has l (u0, (l := a)) a where get (_,(_ := a)) = a
+instance Has l ((l := a), u0, u1) a where get ((_ := a),_,_) = a
+instance Has l (u0, (l := a), u1) a where get (_,(_ := a),_) = a
+instance Has l (u0, u1, (l := a)) a where get (_,_,(_ := a)) = a
 
 -- Provide convenient syntax: $("foo") for Proxy :: Proxy "foo".
 instance IsString (Q Exp) where
@@ -50,7 +52,7 @@ instance l ~ l' => IsLabel (l :: Symbol) (Proxy l') where
   fromLabel _ = Proxy
 
 instance Has l r a => IsLabel (l :: Symbol) (r -> a) where
-  fromLabel _ = get (Proxy :: Proxy l)
+  fromLabel _ = get @l
 
 ----------------------------------------------------------------------------------------------------
 

diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -68,5 +68,5 @@ mentioned = ( #url := "https://api.github.com/repos/commercialhaskell/intero/iss
 main :: IO ()
 main = do
   print $ #url mentioned           -- "https://api.github.com/repos/commercialhaskell/intero/issues/64"
-  print $ #login $ #user mentioned -- "themoritz"
-  print $ #id    $ #user mentioned -- 3522732
+  print $ #login (#user mentioned) -- "themoritz"
+  print $ (#id . #user) mentioned  -- 3522732
diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | This module provides a way to name the fields in a regular
 -- Haskell tuple and then look them up later, statically.
@@ -21,7 +22,7 @@ import GHC.TypeLits
 import GHC.OverloadedLabels
 
 -- | The syntax and the type of a field assignment.
-data l := t = (KnownSymbol l) => Proxy l := t
+data l := t = KnownSymbol l => Proxy l := t
 
 -- Simple show instance for a field.
 instance (Show t) => Show (l := t) where
@@ -45,9 +46,12 @@ instance Has l (u0, u1, (l := a)) a where get _ (_,_,(_ := a)) = a
 instance IsString (Q Exp) where
   fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]
 
-instance (l ~ l') => IsLabel (l :: Symbol) (Proxy l') where
+instance l ~ l' => IsLabel (l :: Symbol) (Proxy l') where
   fromLabel _ = Proxy
 
+instance Has l r a => IsLabel (l :: Symbol) (r -> a) where
+  fromLabel _ = get (Proxy :: Proxy l)
+
 ----------------------------------------------------------------------------------------------------
 
 type User = ( "login" := String, "id" := Integer )
@@ -63,6 +67,6 @@ mentioned = ( #url := "https://api.github.com/repos/commercialhaskell/intero/iss
 
 main :: IO ()
 main = do
-  print $ get #url mentioned               -- "https://api.github.com/repos/commercialhaskell/intero/issues/64"
-  print $ get #login $ get #user mentioned -- "themoritz"
-  print $ get #id $ get #user mentioned    -- 3522732
+  print $ #url mentioned           -- "https://api.github.com/repos/commercialhaskell/intero/issues/64"
+  print $ #login $ #user mentioned -- "themoritz"
+  print $ #id    $ #user mentioned -- 3522732
diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -7,34 +7,34 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedLabels #-}
 
 -- | This module provides a way to name the fields in a regular
 -- Haskell tuple and then look them up later, statically.
 
-module NamedTuple
-  (module NamedTuple
-  ,module Data.Proxy)
-  where
+module Main where
 
 import Data.String
 import Language.Haskell.TH
 import Data.Proxy
 import GHC.TypeLits
+import GHC.OverloadedLabels
 
 -- | The syntax and the type of a field assignment.
-data l := t = KnownSymbol l => Proxy (l :: Symbol) := t
+data l := t = (KnownSymbol l) => Proxy l := t
 
 -- Simple show instance for a field.
-instance Show t => Show (l := t) where
+instance (Show t) => Show (l := t) where
   show (l := t) = symbolVal l ++ " := " ++ show t
 
 -- | Means to search for a field within a tuple.
 -- We could add `set` to this, or just have a `lens` method
 -- which generates a lens for that field.
 class Has (l :: Symbol) r a | l r -> a where
-  get :: f l -> r -> a
+  get :: Proxy l -> r -> a
 
 -- Instances which we could easily generate with TH.
+instance Has l (l := a) a where get _ (_ := a) = a
 instance Has l ((l := a), u0) a where get _ ((_ := a),_) = a
 instance Has l (u0, (l := a)) a where get _ (_,(_ := a)) = a
 instance Has l ((l := a), u0, u1) a where get _ ((_ := a),_,_) = a
@@ -43,4 +43,26 @@ instance Has l (u0, u1, (l := a)) a where get _ (_,_,(_ := a)) = a
 
 -- Provide convenient syntax: $("foo") for Proxy :: Proxy "foo".
 instance IsString (Q Exp) where
-  fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]
+  fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]
+
+instance (l ~ l') => IsLabel (l :: Symbol) (Proxy l') where
+  fromLabel _ = Proxy
+
+----------------------------------------------------------------------------------------------------
+
+type User = ( "login" := String, "id" := Integer )
+
+user :: User
+user = ( #login := "themoritz", #id := 3522732 )
+
+mentioned :: ( "url" := String, "title" := String, "user" := User )
+mentioned = ( #url := "https://api.github.com/repos/commercialhaskell/intero/issues/64"
+            , #title := "Support GHCJS"
+            , #user := user
+            )
+
+main :: IO ()
+main = do
+  print $ get #url mentioned               -- "https://api.github.com/repos/commercialhaskell/intero/issues/64"
+  print $ get #login $ get #user mentioned -- "themoritz"
+  print $ get #id $ get #user mentioned    -- 3522732
diff --git a/X_example.hs b/X_example.hs
@@ -1,12 +0,0 @@
-{-# LANGUAGE DataKinds, OverloadedStrings, TemplateHaskell #-}
--- Taken from JSON from the GitHub API.
-import NamedTuple
-mentioned =
-  (
-    $("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64",
-    $("title") := "Support GHCJS",
-    $("user") := (
-       $("login") := "themoritz",
-       $("id") := 3522732
-      )
-  )

diff --git a/X_repl.hs b/X_repl.hs
@@ -1,10 +0,0 @@
-> mentioned
-(url := "https://api.github.com/repos/commercialhaskell/intero/issues/64",title := "Support GHCJS",user := (login := "themoritz",id := 3522732))
-> get $("login") (get $("user") mentioned)
-"themoritz"
-> get $("id") (get $("user") mentioned)
-3522732
-> :t get $("id") (get $("user") ($("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64", $("title") := "Support GHCJS", $("user") := ($("login") := "themoritz", $("id") := 3522732)))
-Num a => a
-> get $("id") (get $("user") ($("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64", $("title") := "Support GHCJS", $("user") := ($("login") := "themoritz", $("id") := 3522732)))
-3522732

diff --git a/X_repl.hs b/X_repl.hs
@@ -3,4 +3,8 @@
 > get $("login") (get $("user") mentioned)
 "themoritz"
 > get $("id") (get $("user") mentioned)
+3522732
+> :t get $("id") (get $("user") ($("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64", $("title") := "Support GHCJS", $("user") := ($("login") := "themoritz", $("id") := 3522732)))
+Num a => a
+> get $("id") (get $("user") ($("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64", $("title") := "Support GHCJS", $("user") := ($("login") := "themoritz", $("id") := 3522732)))
 3522732
diff --git a/X_example.hs b/X_example.hs
@@ -8,5 +8,5 @@ mentioned =
     $("user") := (
        $("login") := "themoritz",
        $("id") := 3522732
-       )
-    )
+      )
+  )
diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -22,7 +22,7 @@ import Data.Proxy
 import GHC.TypeLits
 
 -- | The syntax and the type of a field assignment.
-data l := t = KnownSymbol l => Proxy (l ::Symbol) := t
+data l := t = KnownSymbol l => Proxy (l :: Symbol) := t
 
 -- Simple show instance for a field.
 instance Show t => Show (l := t) where

diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -29,6 +29,8 @@ instance Show t => Show (l := t) where
   show (l := t) = symbolVal l ++ " := " ++ show t
 
 -- | Means to search for a field within a tuple.
+-- We could add `set` to this, or just have a `lens` method
+-- which generates a lens for that field.
 class Has (l :: Symbol) r a | l r -> a where
   get :: f l -> r -> a
 

diff --git a/X_example.hs b/X_example.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds, OverloadedStrings, TemplateHaskell #-}
+-- Taken from JSON from the GitHub API.
 import NamedTuple
 mentioned =
   (

diff --git a/X_repl.hs b/X_repl.hs
@@ -1,4 +1,6 @@
 > mentioned
 (url := "https://api.github.com/repos/commercialhaskell/intero/issues/64",title := "Support GHCJS",user := (login := "themoritz",id := 3522732))
 > get $("login") (get $("user") mentioned)
-"themoritz"
+"themoritz"
+> get $("id") (get $("user") mentioned)
+3522732
diff --git a/NamedTuple.hs b/NamedTuple.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- | This module provides a way to name the fields in a regular
+-- Haskell tuple and then look them up later, statically.
+
+module NamedTuple
+  (module NamedTuple
+  ,module Data.Proxy)
+  where
+
+import Data.String
+import Language.Haskell.TH
+import Data.Proxy
+import GHC.TypeLits
+
+-- | The syntax and the type of a field assignment.
+data l := t = KnownSymbol l => Proxy (l ::Symbol) := t
+
+-- Simple show instance for a field.
+instance Show t => Show (l := t) where
+  show (l := t) = symbolVal l ++ " := " ++ show t
+
+-- | Means to search for a field within a tuple.
+class Has (l :: Symbol) r a | l r -> a where
+  get :: f l -> r -> a
+
+-- Instances which we could easily generate with TH.
+instance Has l ((l := a), u0) a where get _ ((_ := a),_) = a
+instance Has l (u0, (l := a)) a where get _ (_,(_ := a)) = a
+instance Has l ((l := a), u0, u1) a where get _ ((_ := a),_,_) = a
+instance Has l (u0, (l := a), u1) a where get _ (_,(_ := a),_) = a
+instance Has l (u0, u1, (l := a)) a where get _ (_,_,(_ := a)) = a
+
+-- Provide convenient syntax: $("foo") for Proxy :: Proxy "foo".
+instance IsString (Q Exp) where
+  fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]
diff --git a/X_example.hs b/X_example.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DataKinds, OverloadedStrings, TemplateHaskell #-}
+import NamedTuple
+mentioned =
+  (
+    $("url") := "https://api.github.com/repos/commercialhaskell/intero/issues/64",
+    $("title") := "Support GHCJS",
+    $("user") := (
+       $("login") := "themoritz",
+       $("id") := 3522732
+       )
+    )
diff --git a/X_repl.hs b/X_repl.hs
@@ -0,0 +1,4 @@
+> mentioned
+(url := "https://api.github.com/repos/commercialhaskell/intero/issues/64",title := "Support GHCJS",user := (login := "themoritz",id := 3522732))
+> get $("login") (get $("user") mentioned)
+"themoritz"
No results found