Select a list from a 2D list, take the last item from its nearest non empty left neighbour and put it at its head

Question

I've just got into Haskell a few days ago and I love it. I'm looking for some pointers and best practices on how to organise and write Haskell code specifically when it comes to managing errors, which I have done using Maybe.

The following is an implementation of "select a list from a 2D list, take the last item from its nearest non empty left neighbour and put it at its head" which is going to be a sub-routine of a puzzle solver.

How can I improve the succinctness of my function? I notice that the more complex the logic of my code gets, it starts to be somewhat unreadable.

module Seq where

import Data.Maybe

{-
 - Given a 2D list, select a list via 1-based index
 - Transfer the last item  of its immediate non blank
 - left neighbour to its head.
 - @param [[Int]]   input 2D list 
 - @param Int       index of target list 
 - @return          the input 2D list after operation -}
pull  :: Maybe [[Int]] -> Int -> Maybe [[Int]]

-- CASE : null input
pull Nothing _                = Nothing
-- CASE : nothing left to pull
pull (Just _) 1               = Nothing
pull (Just ([]:xss)) 2        = Nothing
-- CASE : index out of bounds
pull (Just [xs]) n            = Nothing

-- CASE : currently nothing to pull
pull (Just ([]:xs:xss)) n
  | p' == Nothing = Nothing
  | otherwise     = Just ([] : p'')
  where
    p' = pull (Just (xs:xss)) (n-1)
    p''= fromJust p'

-- CASE : base case; immediate pull
pull (Just (xs:xs2:xss)) 2   = Just ((init xs) : ((last xs):xs2) : xss)

-- CASE : intermediary blank; split results
pull (Just (xs:[]:xss)) n
  | p' == Nothing = Nothing
  | otherwise     = Just ((head p'') : [] : (tail p''))
  where
    p' = pull (Just (xs:xss)) (n-1)
    p''= fromJust p'

-- CASE : typical recursion to destination
pull (Just (xs:xs2:xss)) n
  | p' == Nothing = Nothing
  | otherwise     = Just (xs : p'')
  where
    p' = pull (Just (xs2:xss)) (n-1)
    p''= fromJust p'

The following are test cases for the function:

-- pull (Just [[1,2],[],[3],[]]) 4 == Just [[1,2],[],[],[3]]
-- pull (Just [[1,2],[],[3],[]]) 3 == Just [[1],[],[2,3],[]]
-- pull (Just [[1,2],[],[3],[]]) 2 == Just [[1],[2],[3],[]]
-- pull (Just [[],[],[1,2,3],[]) 2 == Nothing

Answer 1

First of all, there is no need for pull's first parameter to be Maybe [[Int]]. More on that later. Also, it will get easier if we switch the parameters. Also more on that later.

So let's start with that modification:

pull  :: Int -> [[Int]] -> Maybe [[Int]]
pull 1 _      = Nothing
pull 2 ([]:_) = Nothing
pull _ [_]    = Nothing

As you can see, I don't use names for things I'm not interested in. This makes it possible to focus on the interesting parts, e.g. the 1 and 2 matches, and the single-element match in the last line.

Now, your other definitions get a lot easier if you don't use guards, but pattern matching instead. If we rewrote the next pattern with your style, we end up with:

pull n ([]:xs:xss) =
  | p' == Nothing = Nothing
  | otherwise     = Just ([] : p'')
  where
    p' = pull (n-1) (xs:xss)
    p''= fromJust p'

Which is slightly easier due to the missing Justs in pull (n-1) …. However, with a case … of …, it's a lot more succinct:

pull n ([]:xss) = case pull (n-1) xss of
  Nothing -> Nothing
  Just p  -> Just ([] : p)

This "if there is Nothing return nothing, otherwise change the Just value" slightly pattern is so common, that there is even a function for that, fmap, which you can think of as

fmap :: (a -> b) -> Maybe a -> Maybe b
fmap _ Nothing  = Nothing
fmap f (Just v) = Just (f v)

So we can shorten that whole case to

pull n ([]:xss) = fmap ([]:) (pull (n-1) xss) -- *

We continue for the following cases:

pull 2 (xs:ys:xss) = Just ((init xs) : ((last xs):ys) : xss)
pull n (xs:[]:xss) = case pull (n-1) (xs:xss) of
  Nothing -> Nothing
  Just p  -> Just ((head p) : [] : (tail p))

pull n (xs:xss) = fmap (xs:) (pull (n-1) xss) -- *

Note that in both cases marked with -- *, you pattern matched on xs2:xss and used xs2:xss. That's not necessary.

So all patterns are:

pull  :: Int -> [[Int]] -> Maybe [[Int]]
pull 1 _           = Nothing
pull 2 ([]:_)      = Nothing
pull _ [_]         = Nothing
pull n ([]:xss)    = fmap ([]:) (pull (n-1) xss) 
pull 2 (xs:ys:xss) = Just ((init xs) : ((last xs):ys) : xss)
pull n (xs:[]:xss) = case pull (n-1) (xs:xss) of
  Nothing -> Nothing
  Just p  -> Just ((head p) : [] : (tail p))
pull n (xs:xss) = fmap (xs:) (pull (n-1) xss)

Now that you can see all cases, it should be obvious that your missing at least one, namely the one for the empty list pull 0 []. Also note that using last and init isn't very efficient, since you need to traverse the list twice. You could write a function like

splitLast :: [a] -> ([a], a)

which returns both the init and the last element. But that's left as an exercise.

TL;DR

• use case … of … (or pattern matching) instead of guards if you want to use the matched value either way (or use pattern guards).
• make sure that you handle all cases
• use Maybe on outputs; if your function cannot do something sensible with Maybe inputs, don't use it, that's what >>= is for.

Answer 2

Since you only use call the nonpartial case of tlTrns and only use it once, you can inline it. Pattern matching is better than head/tail/fst/snd. Maybe's fmap can be used again.

-- | Given a 2D list, select a list via index,
-- transfer the last item  of its immediate non blank
-- left neighbour to its head.
pull :: Int           -- based 1 index
      -> [[a]]        -- 2D list
      -> Maybe [[a]]  -- result after operation
pull _ []           = Nothing                       -- empty list / out of bounds
pull 1 _            = Nothing                       -- no left neighbour
pull 2 ([]:_)       = Nothing                       -- empty left neighbour
pull 2 (xs:ys:yss)  = Just $ let (pl, pr) = splLst xs
                        in pl:(pr:ys):yss           -- base case take from left neighbour
pull n (xs:[]:xss)  = fmap (\(p:ps) -> p:[]:ps) (pull (n-1) (xs:xss))
                                                    -- carry over due to blank mid
pull n (xs:xss)     = fmap (xs:) (pull (n-1) xss)   -- recurse tail

You can make splLst nonpartial by using Maybe. Then it turns out that Data.List.Extra already implements that and calls it unsnoc. Using it, you can eliminate another case from pull.

import Data.List.Extra (unsnoc)

-- | Given a 2D list, select a list via index,
-- transfer the last item  of its immediate non blank
-- left neighbour to its head.
pull :: Int           -- based 1 index
      -> [[a]]        -- 2D list
      -> Maybe [[a]]  -- result after operation
pull _ []           = Nothing                       -- empty list / out of bounds
pull 1 _            = Nothing                       -- no left neighbour
pull 2 (xs:ys:yss)  = fmap (\(pl,pr) -> pl:(pr:ys):yss) (unsnoc xs)
                                                    -- base case take from left neighbour
pull n (xs:[]:xss)  = fmap (\(p:ps) -> p:[]:ps) (pull (n-1) (xs:xss))
                                                    -- carry over due to blank mid
pull n (xs:xss)     = fmap (xs:) (pull (n-1) xss)   -- recurse tail

Edit: Since we've already silently been passing pull 2 [x] into the last case, we might as well get rid of pull 1 _, which can also be handled silently, for:

pull _ []           = Nothing
pull 2 (xs:ys:yss)  = fmap (\(pl,pr) -> pl:(pr:ys):yss) (unsnoc xs)
pull n (xs:[]:xss)  = fmap (\(p:ps) -> p:[]:ps) (pull (n-1) (xs:xss))
pull n (xs:xss)     = fmap (xs:) (pull (n-1) xss)

Answer 3

Thanks for the response @Zeta and introducing me to fmap and case ... of ... Using them made the cases for the functions much more clearer and I noticed some redundant pattern matches as well and have removed them. I've implemented splitAtLast as suggested as well. The base case was extracted for reusability as another function had the exact same base case as well. This is the resulting code:

-- | Given a list, get tuple of (init, last)
splLst :: [a] -> ([a],a)
splLst []           = error "empty list"            -- empty list error
splLst [x]          = ([],x)                        -- base case one element
splLst (x:xs)       = let s' = splLst xs            -- recurse partial solve for init
                      in (x:(fst s'),snd s')
------------------------------------------------------

-- | Given a 2D list, transfer the tail of the head list
-- to the head of the following list
tlTrns :: [[a]] -> [[a]]
tlTrns []           = error "empty list"             -- empty list
tlTrns ([_])        = error "no neighbour"           -- no neighbour
tlTrns (xs:ys:xss)  = let p = splLst xs              -- base case tail transfer
                     in (fst p) : ((snd p):ys) :xss
------------------------------------------------------


-- | Given a 2D list, select a list via index,
-- transfer the last item  of its immediate non blank
-- left neighbour to its head.
pull :: Int           -- based 1 index
      -> [[a]]        -- 2D list
      -> Maybe [[a]]  -- result after operation
pull _ []           = Nothing                       -- empty list / out of bounds
pull 1 _            = Nothing                       -- no left neighbour
pull 2 ([]:_)       = Nothing                       -- empty left neighbour
pull 2 xss          = Just $ tlTrns xss             -- base case take from left neighbour
pull n (xs:[]:xss)  = case pull (n-1) (xs:xss) of   -- carry over due to blank mid
                        Nothing -> Nothing
                        Just p  -> Just ((head p):[]:(tail p))
pull n (xs:xss)     = fmap (xs:) (pull (n-1) xss)   -- recurse tail
------------------------------------------------------