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