
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

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
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 Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

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"
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
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 Haskell-C...@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-C...@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe

On 16 Jan 2009, at 02:30, eyal.lotem@gmail.com 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

On Fri, Jan 16, 2009 at 12:52 AM, Ryan Ingram
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

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
participants (4)
-
eyal.lotem@gmail.com
-
Levi Greenspan
-
Ryan Ingram
-
Thomas Davie