Skip to content

Instantly share code, notes, and snippets.

@danidiaz
Last active August 5, 2020 14:24

Revisions

  1. danidiaz revised this gist Feb 25, 2015. 1 changed file with 5 additions and 0 deletions.
    5 changes: 5 additions & 0 deletions reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -1,3 +1,8 @@
    -- Example of a dynamically generated FromJSON instance.
    --
    -- Can be useful when one needs to use a function with a
    -- FromJSON constraint, but some detail about the
    -- conversion from JSON is not known until runtime.
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}
  2. danidiaz revised this gist Feb 24, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -35,7 +35,7 @@ newtype J a s = J { runJ :: a }
    -- use reflect to recover the function and implement
    -- our FromJSON instance for J.
    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v
    parseJSON (Object v) = J <$> reflect (Proxy :: Proxy s) v

    -- Convince the compiler that the phantom type in the proxy
    -- supplied by reify is the same as the phantom type in J.
  3. danidiaz revised this gist Feb 24, 2015. 1 changed file with 0 additions and 2 deletions.
    2 changes: 0 additions & 2 deletions reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -18,8 +18,6 @@ import Control.Applicative
    import Control.Lens (preview) -- from lens
    import Data.Aeson.Lens (_Value,_String) -- form lens-aeson

    import System.IO

    data Foo = Foo
    {
    field1 :: Int
  4. danidiaz revised this gist Feb 24, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -54,7 +54,7 @@ exampleJSON = maybe Null id (preview _Value str)
    main :: IO ()
    main = do
    putStrLn "Enter prefix for the fields: "
    -- better input "zz" or it won't parse!
    -- "zz" must be entered for the parse to succeed
    prefix <- fmap pack getLine

    -- fromJSON uses the dynamically generated FromJSON instance
  5. danidiaz revised this gist Feb 24, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -14,7 +14,7 @@ import Data.Aeson.Types (Parser)

    import Control.Applicative

    -- These imports only for constructing the example value
    -- These imports are only for constructing the example value
    import Control.Lens (preview) -- from lens
    import Data.Aeson.Lens (_Value,_String) -- form lens-aeson

  6. danidiaz revised this gist Feb 24, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -14,7 +14,7 @@ import Data.Aeson.Types (Parser)

    import Control.Applicative

    -- These only for constructing the example value
    -- These imports only for constructing the example value
    import Control.Lens (preview) -- from lens
    import Data.Aeson.Lens (_Value,_String) -- form lens-aeson

  7. danidiaz revised this gist Feb 24, 2015. 1 changed file with 6 additions and 9 deletions.
    15 changes: 6 additions & 9 deletions reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -1,6 +1,3 @@
    -- Required packages:
    -- aeson reflection lens lens-aeson
    --
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}
    @@ -10,16 +7,16 @@
    import Data.Reflection -- from reflection
    import Data.Monoid -- from base
    import Data.Proxy -- from tagged
    import Data.Text
    import Data.Monoid
    import Data.Aeson
    import Data.Text -- from text
    import Data.Monoid
    import Data.Aeson -- from aeson
    import Data.Aeson.Types (Parser)

    import Control.Applicative

    -- This only for constructing the example value
    import Control.Lens (preview)
    import Data.Aeson.Lens (_Value,_String)
    -- These only for constructing the example value
    import Control.Lens (preview) -- from lens
    import Data.Aeson.Lens (_Value,_String) -- form lens-aeson

    import System.IO

  8. danidiaz revised this gist Feb 23, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -43,7 +43,7 @@ instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v

    -- Convince the compiler that the phantom type in the proxy
    -- is the same as the phantom type in J.
    -- supplied by reify is the same as the phantom type in J.
    --
    -- Otherwise the FromJSON instance for J won't kick in.
    asProxyJ :: Proxy s -> J a s -> J a s
  9. danidiaz revised this gist Feb 23, 2015. 1 changed file with 2 additions and 1 deletion.
    3 changes: 2 additions & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -63,7 +63,8 @@ main = do
    -- fromJSON uses the dynamically generated FromJSON instance
    let result = reify (fooParser prefix) $ \proxy ->
    -- We must eliminate the J newtype before returning
    -- because the phantom type cannot escape the callback.
    -- because, thanks to parametricity,
    -- the phantom type cannot escape the callback.
    runJ . asProxyJ proxy <$> fromJSON exampleJSON

    putStrLn (show (result :: Result Foo))
  10. danidiaz revised this gist Feb 23, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -45,7 +45,7 @@ instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    -- Convince the compiler that the phantom type in the proxy
    -- is the same as the phantom type in J.
    --
    -- Otherwise our FromJSON instance won't kick in.
    -- Otherwise the FromJSON instance for J won't kick in.
    asProxyJ :: Proxy s -> J a s -> J a s
    asProxyJ _ = id

  11. danidiaz revised this gist Feb 23, 2015. 1 changed file with 2 additions and 1 deletion.
    3 changes: 2 additions & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -37,7 +37,8 @@ fooParser prefix o = do
    newtype J a s = J { runJ :: a }

    -- If the phantom type s reifies the parsing function, we can
    -- recover the function to implement our FromJSON instance for J.
    -- use reflect to recover the function and implement
    -- our FromJSON instance for J.
    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v

  12. danidiaz revised this gist Feb 23, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -37,7 +37,7 @@ fooParser prefix o = do
    newtype J a s = J { runJ :: a }

    -- If the phantom type s reifies the parsing function, we can
    -- recover the function to implement our JSON instance for J.
    -- recover the function to implement our FromJSON instance for J.
    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v

  13. danidiaz revised this gist Feb 23, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -37,7 +37,7 @@ fooParser prefix o = do
    newtype J a s = J { runJ :: a }

    -- If the phantom type s reifies the parsing function, we can
    -- recover the function to implement our JSON instance.
    -- recover the function to implement our JSON instance for J.
    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v

  14. danidiaz revised this gist Feb 23, 2015. 1 changed file with 16 additions and 8 deletions.
    24 changes: 16 additions & 8 deletions reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -35,26 +35,34 @@ fooParser prefix o = do

    -- A wrapper over Foo carrying a phantom type s
    newtype J a s = J { runJ :: a }


    -- If the phantom type s reifies the parsing function, we can
    -- recover the function to implement our JSON instance.
    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v

    -- Convince the compiler that the phantom type in the proxy
    -- is the same as the phantom type in J.
    --
    -- Otherwise our FromJSON instance won't kick in.
    asProxyJ :: Proxy s -> J a s -> J a s
    asProxyJ _ = id

    exampleJSON :: Value
    exampleJSON = maybe Null id (preview _Value str)
    where
    str = "{ \"zzfield1\" : 5, \"zzfield2\" : 7 }"::Text

    main :: IO ()
    main = do
    putStrLn "Enter prefix for the fields: "
    -- better input "zz" or it won't parse!
    prefix <- fmap pack getLine

    -- fromJSON uses the dynamically generated FromJSON instance
    let result = reify (fooParser prefix) $ \proxy ->
    fmap runJ (fromJSON exampleJSON `asProxyOf` proxy)

    asProxyOf :: Result (J a s) -> Proxy s -> Result (J a s)
    asProxyOf r _ = r

    -- We must eliminate the J newtype before returning
    -- because the phantom type cannot escape the callback.
    runJ . asProxyJ proxy <$> fromJSON exampleJSON

    putStrLn (show (result :: Result Foo))
  15. danidiaz revised this gist Feb 22, 2015. 1 changed file with 0 additions and 1 deletion.
    1 change: 0 additions & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -44,7 +44,6 @@ exampleJSON = maybe Null id (preview _Value str)
    where
    str = "{ \"zzfield1\" : 5, \"zzfield2\" : 7 }"::Text


    main :: IO ()
    main = do
    putStrLn "Enter prefix for the fields: "
  16. danidiaz revised this gist Feb 22, 2015. 1 changed file with 0 additions and 1 deletion.
    1 change: 0 additions & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -38,7 +38,6 @@ newtype J a s = J { runJ :: a }

    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v
    parseJSON _ = error "oops"

    exampleJSON :: Value
    exampleJSON = maybe Null id (preview _Value str)
  17. danidiaz revised this gist Feb 22, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -52,7 +52,7 @@ main = do
    -- better input "zz" or it won't parse!
    prefix <- fmap pack getLine

    -- fromJSON uses the dynamically created FromJSON instance
    -- fromJSON uses the dynamically generated FromJSON instance
    let result = reify (fooParser prefix) $ \proxy ->
    fmap runJ (fromJSON exampleJSON `asProxyOf` proxy)

  18. danidiaz created this gist Feb 22, 2015.
    62 changes: 62 additions & 0 deletions reflection_aeson.hs
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,62 @@
    -- Required packages:
    -- aeson reflection lens lens-aeson
    --
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE OverloadedStrings #-}

    import Data.Reflection -- from reflection
    import Data.Monoid -- from base
    import Data.Proxy -- from tagged
    import Data.Text
    import Data.Monoid
    import Data.Aeson
    import Data.Aeson.Types (Parser)

    import Control.Applicative

    -- This only for constructing the example value
    import Control.Lens (preview)
    import Data.Aeson.Lens (_Value,_String)

    import System.IO

    data Foo = Foo
    {
    field1 :: Int
    , field2 :: Int
    } deriving (Show)

    fooParser :: Text -> Object -> Parser Foo
    fooParser prefix o = do
    Foo <$> o .: (prefix <> "field1") <*> o .: (prefix <> "field2")

    -- A wrapper over Foo carrying a phantom type s
    newtype J a s = J { runJ :: a }

    instance Reifies s (Object -> Parser a) => FromJSON (J a s) where
    parseJSON (Object v) = (fmap J . reflect (Proxy :: Proxy s)) v
    parseJSON _ = error "oops"

    exampleJSON :: Value
    exampleJSON = maybe Null id (preview _Value str)
    where
    str = "{ \"zzfield1\" : 5, \"zzfield2\" : 7 }"::Text


    main :: IO ()
    main = do
    putStrLn "Enter prefix for the fields: "
    -- better input "zz" or it won't parse!
    prefix <- fmap pack getLine

    -- fromJSON uses the dynamically created FromJSON instance
    let result = reify (fooParser prefix) $ \proxy ->
    fmap runJ (fromJSON exampleJSON `asProxyOf` proxy)

    asProxyOf :: Result (J a s) -> Proxy s -> Result (J a s)
    asProxyOf r _ = r

    putStrLn (show (result :: Result Foo))