How to simplify this code?

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
6 messages Options
Reply | Threaded
Open this post in threaded view
|

How to simplify this code?

Levi Greenspan
Dear list members,

I started looking into monadic programming in Haskell and I have some
difficulties to come up with code that is concise, easy to read and
easy on the eyes. In particular I would like to have a function "add"
with following type signature: JSON a => MyData -> String -> a ->
MyData. MyData holds a JSValue and add should add a key and a value to
this JSON object. here is what I came up with and I am far from
satisfied. Maybe someone can help me to simplify this...

module Test where

import Text.JSON
import Data.Maybe (isJust, fromJust)
import Control.Monad

data MyData = MyData { json :: JSValue } deriving (Read, Show)

jsObj :: JSValue -> Maybe (JSObject JSValue)
jsObj (JSObject o) = Just o
jsObj _ = Nothing

add :: JSON a => MyData -> String -> a -> MyData
add m k v = fromJust $ (return $ json m) >>= jsObj >>= (return .
fromJSObject) >>= (return . ((k, showJSON v):)) >>= (return .
toJSObject) >>= (return . showJSON) >>= \js -> (return $ m { json = js
})

add2 :: JSON a => MyData -> String -> a -> MyData
add2 m k v = fromJust $ (\js -> m { json = js }) `liftM` (showJSON
`liftM` (toJSObject `liftM` (((k, showJSON v):) `liftM` (fromJSObject
`liftM` (jsObj $ json m)))))

add3 :: JSON a => MyData -> String -> a -> MyData
add3 = undefined -- How to simplify add?


What the code essentially does is that using functions from Text.JSON,
it gets the list of key-value pairs and conses another pair to it
before wrapping it again in the JSValue-Type.

Many thanks,
Levi
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: How to simplify this code?

Ryan Ingram
Here's a series of refactorings that I feel gets to the essence of the code.

For reference, here's the original.

> add :: JSON a => MyData -> String -> a -> MyData
> add m k v = fromJust $ (return $ json m) >>= jsObj >>= (return .
> fromJSObject) >>= (return . ((k, showJSON v):)) >>= (return .
> toJSObject) >>= (return . showJSON) >>= \js -> (return $ m { json = js
> })

-- turn into do notation
add :: JSON a => MyData -> String -> a -> MyData
add m k v = fromJust $ do
        t1 <- return $ json m
        t2 <- jsObj t1
        t3 <- return $ fromJSObject t2
        t4 <- return ( (k, showJSON v) : t3 )
        t5 <- return $ toJSObject t4
        js <- return $ showJSON t5
        t6 <- return $ m { json = js }
        return t6

-- replace "var <- return exp" with "let var = exp"
add :: JSON a => MyData -> String -> a -> MyData
add m k v = fromJust $ do
        let t1 = json m
        t2 <- jsObj t1
        let t3 = fromJSObject t2
        let t4 = (k, showJSON v) : t3
        let t5 = toJSObject t4
        let js = showJSON t5
        let t6 = m { json = js }
        return t6

-- inline some small definitions
add m k v = fromJust $ do
        t2 <- jsObj (json m)
        let js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject t2)
        let t6 = m { json = js }
        return t6

-- there's only one real "Maybe" object in here, and we fromJust afterwards,
-- so put the "can't fail" assumption in the right place.
--
-- This is the only refactoring that I felt was at all "tricky" to figure out.
add m k v =
        let t2 = fromJust $ jsObj (json m)
            js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject t2)
            t6 = m { json = js }
        in t6

-- sugar let, inline t6
add m k v = m { json = js } where
    t2 = fromJust $ jsObj (json m)
    js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject t2)

-- inline t2
add m k v = m { json = js } where
    js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject
(fromJust $ jsObj (json m)))

-- uninline dictionary entry
add m k v = m { json = js } where
    js = showJSON $ toJSObject (newEntry : fromJSObject (fromJust $
jsObj (json m)))
    newEntry = (k, showJSON v)

-- factor out modification
modifyJSON f m = m { json = f (json m) }
add m k v = modifyJson go m where
    go js = showJSON $ toJSObject (newEntry : fromJSObject (fromJust $
jsObj js))
    newEntry = (k, showJSON v)

-- turn into pipeline
modifyJSON f m = m { json = f (json m) }
add m k v = modifyJSON go m where
    go js = showJSON $ toJSObject $ (newEntry :) $ fromJSObject $
fromJust $ jsObj js
    newEntry = (k, showJSON v)

-- pointless
modifyJSON f m = m { json = f (json m) }
add m k v = modifyJSON go m where
    go = showJSON . toJSObject . (newEntry :) . fromJSObject . fromJust . jsObj
    newEntry = (k, showJSON v)

Final result:
> modifyJSON f m = m { json = f (json m) }
>
> add m k v = modifyJSON go m where
>     go = showJSON . toJSObject . (newEntry :) . fromJSObject . fromJust . jsObj
>     newEntry = (k, showJSON v)

Some stylistic choices are debatable (pointless vs. not, inline vs.
not), but I think this is a lot more readable than the >>= and liftM
madness you had going.

I also might refactor the (fromJSObject --> some transformation -->
toJSObject) path; this seems like a fundamental operation on "MyData",
but I don't know enough about the library you are using to suggest the
direction to go with this.

  -- ryan


On Thu, Jan 15, 2009 at 11:14 AM, Levi Greenspan
<[hidden email]> wrote:

> Dear list members,
>
> I started looking into monadic programming in Haskell and I have some
> difficulties to come up with code that is concise, easy to read and
> easy on the eyes. In particular I would like to have a function "add"
> with following type signature: JSON a => MyData -> String -> a ->
> MyData. MyData holds a JSValue and add should add a key and a value to
> this JSON object. here is what I came up with and I am far from
> satisfied. Maybe someone can help me to simplify this...
>
> module Test where
>
> import Text.JSON
> import Data.Maybe (isJust, fromJust)
> import Control.Monad
>
> data MyData = MyData { json :: JSValue } deriving (Read, Show)
>
> jsObj :: JSValue -> Maybe (JSObject JSValue)
> jsObj (JSObject o) = Just o
> jsObj _ = Nothing
>
> add :: JSON a => MyData -> String -> a -> MyData
> add m k v = fromJust $ (return $ json m) >>= jsObj >>= (return .
> fromJSObject) >>= (return . ((k, showJSON v):)) >>= (return .
> toJSObject) >>= (return . showJSON) >>= \js -> (return $ m { json = js
> })
>
> add2 :: JSON a => MyData -> String -> a -> MyData
> add2 m k v = fromJust $ (\js -> m { json = js }) `liftM` (showJSON
> `liftM` (toJSObject `liftM` (((k, showJSON v):) `liftM` (fromJSObject
> `liftM` (jsObj $ json m)))))
>
> add3 :: JSON a => MyData -> String -> a -> MyData
> add3 = undefined -- How to simplify add?
>
>
> What the code essentially does is that using functions from Text.JSON,
> it gets the list of key-value pairs and conses another pair to it
> before wrapping it again in the JSValue-Type.
>
> Many thanks,
> Levi
> _______________________________________________
> Haskell-Cafe mailing list
> [hidden email]
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: How to simplify this code?

Eyal Lotem
Very nice series of refactorings!

I'd like to add that it might be a better argument order to replace:

JSON a => MyData -> String -> a -> MyData

with:

JSON a => String -> a -> MyData -> MyData

Just so you can get a (MyData -> MyData) transformer, which is often
useful.

Eyal

On Jan 16, 1:52 am, "Ryan Ingram" <[hidden email]> wrote:

> Here's a series of refactorings that I feel gets to the essence of the code.
>
> For reference, here's the original.
>
> > add :: JSON a => MyData -> String -> a -> MyData
> > add m k v = fromJust $ (return $ json m) >>= jsObj >>= (return .
> > fromJSObject) >>= (return . ((k, showJSON v):)) >>= (return .
> > toJSObject) >>= (return . showJSON) >>= \js -> (return $ m { json = js
> > })
>
> -- turn into do notation
> add :: JSON a => MyData -> String -> a -> MyData
> add m k v = fromJust $ do
>         t1 <- return $ json m
>         t2 <- jsObj t1
>         t3 <- return $ fromJSObject t2
>         t4 <- return ( (k, showJSON v) : t3 )
>         t5 <- return $ toJSObject t4
>         js <- return $ showJSON t5
>         t6 <- return $ m { json = js }
>         return t6
>
> -- replace "var <- return exp" with "let var = exp"
> add :: JSON a => MyData -> String -> a -> MyData
> add m k v = fromJust $ do
>         let t1 = json m
>         t2 <- jsObj t1
>         let t3 = fromJSObject t2
>         let t4 = (k, showJSON v) : t3
>         let t5 = toJSObject t4
>         let js = showJSON t5
>         let t6 = m { json = js }
>         return t6
>
> -- inline some small definitions
> add m k v = fromJust $ do
>         t2 <- jsObj (json m)
>         let js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject t2)
>         let t6 = m { json = js }
>         return t6
>
> -- there's only one real "Maybe" object in here, and we fromJust afterwards,
> -- so put the "can't fail" assumption in the right place.
> --
> -- This is the only refactoring that I felt was at all "tricky" to figure out.
> add m k v =
>         let t2 = fromJust $ jsObj (json m)
>             js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject t2)
>             t6 = m { json = js }
>         in t6
>
> -- sugar let, inline t6
> add m k v = m { json = js } where
>     t2 = fromJust $ jsObj (json m)
>     js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject t2)
>
> -- inline t2
> add m k v = m { json = js } where
>     js = showJSON $ toJSObject ((k, showJSON v) : fromJSObject
> (fromJust $ jsObj (json m)))
>
> -- uninline dictionary entry
> add m k v = m { json = js } where
>     js = showJSON $ toJSObject (newEntry : fromJSObject (fromJust $
> jsObj (json m)))
>     newEntry = (k, showJSON v)
>
> -- factor out modification
> modifyJSON f m = m { json = f (json m) }
> add m k v = modifyJson go m where
>     go js = showJSON $ toJSObject (newEntry : fromJSObject (fromJust $
> jsObj js))
>     newEntry = (k, showJSON v)
>
> -- turn into pipeline
> modifyJSON f m = m { json = f (json m) }
> add m k v = modifyJSON go m where
>     go js = showJSON $ toJSObject $ (newEntry :) $ fromJSObject $
> fromJust $ jsObj js
>     newEntry = (k, showJSON v)
>
> -- pointless
> modifyJSON f m = m { json = f (json m) }
> add m k v = modifyJSON go m where
>     go = showJSON . toJSObject . (newEntry :) . fromJSObject . fromJust . jsObj
>     newEntry = (k, showJSON v)
>
> Final result:
>
> > modifyJSON f m = m { json = f (json m) }
>
> > add m k v = modifyJSON go m where
> >     go = showJSON . toJSObject . (newEntry :) . fromJSObject . fromJust . jsObj
> >     newEntry = (k, showJSON v)
>
> Some stylistic choices are debatable (pointless vs. not, inline vs.
> not), but I think this is a lot more readable than the >>= and liftM
> madness you had going.
>
> I also might refactor the (fromJSObject --> some transformation -->
> toJSObject) path; this seems like a fundamental operation on "MyData",
> but I don't know enough about the library you are using to suggest the
> direction to go with this.
>
>   -- ryan
>
> On Thu, Jan 15, 2009 at 11:14 AM, Levi Greenspan
>
> <[hidden email]> wrote:
> > Dear list members,
>
> > I started looking into monadic programming in Haskell and I have some
> > difficulties to come up with code that is concise, easy to read and
> > easy on the eyes. In particular I would like to have a function "add"
> > with following type signature: JSON a => MyData -> String -> a ->
> > MyData. MyData holds a JSValue and add should add a key and a value to
> > this JSON object. here is what I came up with and I am far from
> > satisfied. Maybe someone can help me to simplify this...
>
> > module Test where
>
> > import Text.JSON
> > import Data.Maybe (isJust, fromJust)
> > import Control.Monad
>
> > data MyData = MyData { json :: JSValue } deriving (Read, Show)
>
> > jsObj :: JSValue -> Maybe (JSObject JSValue)
> > jsObj (JSObject o) = Just o
> > jsObj _ = Nothing
>
> > add :: JSON a => MyData -> String -> a -> MyData
> > add m k v = fromJust $ (return $ json m) >>= jsObj >>= (return .
> > fromJSObject) >>= (return . ((k, showJSON v):)) >>= (return .
> > toJSObject) >>= (return . showJSON) >>= \js -> (return $ m { json = js
> > })
>
> > add2 :: JSON a => MyData -> String -> a -> MyData
> > add2 m k v = fromJust $ (\js -> m { json = js }) `liftM` (showJSON
> > `liftM` (toJSObject `liftM` (((k, showJSON v):) `liftM` (fromJSObject
> > `liftM` (jsObj $ json m)))))
>
> > add3 :: JSON a => MyData -> String -> a -> MyData
> > add3 = undefined -- How to simplify add?
>
> > What the code essentially does is that using functions from Text.JSON,
> > it gets the list of key-value pairs and conses another pair to it
> > before wrapping it again in the JSValue-Type.
>
> > Many thanks,
> > Levi
> > _______________________________________________
> > Haskell-Cafe mailing list
> > [hidden email]
> >http://www.haskell.org/mailman/listinfo/haskell-cafe
>
> _______________________________________________
> Haskell-Cafe mailing list
> [hidden email]://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: How to simplify this code?

Levi Greenspan
In reply to this post by Ryan Ingram
On Fri, Jan 16, 2009 at 12:52 AM, Ryan Ingram <[hidden email]> wrote:
> Here's a series of refactorings that I feel gets to the essence of the code.

Indeed it does.

> Final result:
>> modifyJSON f m = m { json = f (json m) }
>>
>> add m k v = modifyJSON go m where
>>     go = showJSON . toJSObject . (newEntry :) . fromJSObject . fromJust . jsObj
>>     newEntry = (k, showJSON v)
>
> Some stylistic choices are debatable (pointless vs. not, inline vs.
> not), but I think this is a lot more readable than the >>= and liftM
> madness you had going.

Definitely. The refactorings you have done are very instructive and
the final result just beautiful. Many many thanks. Exactly the kind of
response I was hoping for.

Cheers,
Levi
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: How to simplify this code?

Thomas Davie
In reply to this post by Levi Greenspan
> add2 :: JSON a => MyData -> String -> a -> MyData
> add2 m k v = fromJust $ (\js -> m { json = js }) `liftM` (showJSON
> `liftM` (toJSObject `liftM` (((k, showJSON v):) `liftM` (fromJSObject
> `liftM` (jsObj $ json m)))))


setJSON m js = m {json = js}

add2 m k v = fromJust $ setJSON m <$> showJSON <$> toJSObjct <$> ((k,  
showJSON v):) <$> fromJSObject <$> (jsObj . json $ m)

now let's push all the fmaps together:

add2 m k v = fromJust . fmap (setJSON m . showJSON . toJSObject . ((k,  
showJSON v):) . fromJSObject) . jsObj . json $ m

much better :)

Bob
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Re: How to simplify this code?

Thomas Davie
In reply to this post by Eyal Lotem

On 16 Jan 2009, at 02:30, [hidden email] wrote:

> Very nice series of refactorings!
>
> I'd like to add that it might be a better argument order to replace:
>
> JSON a => MyData -> String -> a -> MyData
>
> with:
>
> JSON a => String -> a -> MyData -> MyData
>
> Just so you can get a (MyData -> MyData) transformer, which is often
> useful.

Following up on this idea:
add m k v = fromJust . fmap (setJSON m . showJSON . toJSObject . ((k,  
showJSON v):) . fromJSObject) . jsObj . json $ m

can now become:
add k v = fromJust . fmap (setJSON m . showJSON . toJSObject . ((k,  
showJSON v):) . fromJSObject) . jsObj . json

if you switch the type around like that, and then it truely does  
become obvious that this is a (MyData -> MyData) transformer.

Bob
_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe