Question

Beneath this text, you can see some code for creating Arukone puzzles.
But there is a problem: the polymorphic data-type Puzzle a represents an Arukone puzzle with the labels of the type a.

But I would like to have a puzzle-type with the instance of Show class (without using deriving Show.)
The show function would be enough, showsPrec isn’t necessary.

So do you know how this works? I want to define Show for all the types a which are an instance of the following ToChar class?

class ToChar a where
 toChar :: a -> Char

instance ToChar Char where
 toChar = id

instance ToChar Int where
 toChar = head . show

Code :

import Data.Maybe (listToMaybe)

data Size  = Size Int Int deriving (Eq, Show)
data Pos   = Pos  Int Int deriving (Eq, Show)
data Link l = Link l Pos Pos
data Puzzle l = Puzzle Size [Link l]

assign :: Int -> a -> [a] -> [a]
assign 0 v (_:vs) = v:vs
assign n v (v’:vs) = v’: assign (n - 1) v vs

assign2 :: Int -> Int -> a -> [[a]] -> [[a]]
assign2 r c v vs = assign r (assign c v (vs !! r)) vs

assignPos :: Pos -> a -> [[a]] -> [[a]]
assignPos (Pos r c) = assign2 (r-1) (c-1)

tabulate :: Int -> (Int -> a) -> [a]
tabulate 0 _ = []
tabulate i f = f 0 : tabulate (i - 1) (f . (+1))

tabulate2 :: Int -> Int -> (Int -> Int -> a) -> [[a]]
tabulate2 b h f = tabulate h (\r -> tabulate b (\c -> f r c))

tabulatePos :: Size -> (Pos -> a) -> [[a]]
tabulatePos (Size h b) f = tabulate2 b h (\r c -> f (Pos (r +1) (c + 1)))

showPuzzle :: Puzzle a -> [[Maybe a]]
showPuzzle (Puzzle sz links) = tabulatePos sz findPosMaybe
  where findPosMaybe pos =  -- edit: findPosMaybe needs to be further left than the next line
          listToMaybe [l | Link l pos1 pos2 <- links, pos1 == pos || pos2 == pos]

Solutions and Input

*Main> show (Puzzle (Size 2 3) [Link 1 (Pos 1 1) (Pos 1 3), Link 2 (Pos 2 1) (Pos 2 3)])

"1 1\n2 2"


*Main> show (Puzzel (Size 5 5) [Link ’a’ (Pos 3 1) (Pos 4 3), Link ’b’ (Pos 5 1) (Pos 1 5), Link ’c’ (Pos 2 5) (Pos 5 5), Link ’d’ (Pos 4 1) (Pos 2 2)])

"    b\n d  c\na    \nd a  \nb   c"          <-- result -- remarks the spaces

putStrLn of last example

    b
 d  c
a 
d a 
b   c

All help is welcome.

Answer 1

First let’s use the ToChar class to turn the Maybe elements into spaces or values:

maybeToString :: ToChar a => Maybe a -> String
maybeToString Nothing = " "
maybeToString (Just x) = toChar x : ""

Now we can make the Show instance:

instance ToChar a => Show (Puzzle a) where
  show = unlines . map (concatMap maybeToString) . showPuzzle

It’s not clear to me whether you wanted padding or not, so you could alter your maybeToString to say " " and toChar x : " " if you want more space.

With the definitions above we get:

*Main> show (Puzzle (Size 2 3) [Link (1 :: Int) (Pos 1 1) (Pos 1 3), Link 2 (Pos 2 1) (Pos 2 3)]) 
"1 1\n2 2\n"
*Main> putStrLn $ show (Puzzle (Size 2 3) [Link (1 :: Int) (Pos 1 1) (Pos 1 3), Link 2 (Pos 2 1) (Pos 2 3)]) 
1 1
2 2

Example 2:

*Main> show (Puzzle (Size 5 5) [Link 'a' (Pos 3 1) (Pos 4 3), Link 'b' (Pos 5 1) (Pos 1 5), Link 'c' (Pos 2 5) (Pos 5 5), Link 'd' (Pos 4 1) (Pos 2 2)])
"    b\n d  c\na    \nd a  \nb   c\n"
*Main> putStr it
    b
 d  c
a    
d a  
b   c