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" <ryani.s...@gmail.com> 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 > > <greenspan.l...@googlemail.com> 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 _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe