Background

A couple of years ago, my friend Bonnie asked me to help her solve a Calcudoku puzzle. Rather than sit down and try to figure it out, I decided that since I was a powerful, master of the universe, Haskell programmer, I would just write a solver and short circuit all future questions. So I fired up emacs and went to the Calcudoku/ site, imported TagSoup, and started parsing. Next I wrote a solver, using Control.Monad.Logic, and voila, problem solved. However I didn't like that my solver was intimately tied to one website. I wanted a way to conveniently input a Calcudoku puzzle and get back a result. This meant I would have to write Javascript, and a lot of it. Sorry, no can do. Well, once Fay came along, I thought, why not finally write my inputter. While I was at it, I might as well document it so that it might still mean something to me in a couple of months, and perhaps help you, gentle reader, if you struggle with some the same issues I did.

Design

In order to solve a Calcudoku puzzle, we need to know a few things. First the puzzle size. Next the range of values to be used for the puzzle data. Next the type of puzzle, there are three defined at the Calcudoku site, namely single puzzles, double puzzles, and so called killer puzzles. These are global pieces of data that describe the puzzle in general. Next each puzzle consists of regions, and each region has associated with it a value, an operator, and a set of cells. This code is supposed to make the input of this data the least tedious it can be. Once you enter the operator (from a select list) and a value in the text box, you should proceed to click on the cells that comprise the region. While entering the region, you can change the value and the operator, but once the region is finished, these cannot be changed. You can press [Enter] to complete the region, or click on the finish region button. Clicking on a cell while defining a region toggles its membership in the region, so if you accidently added a cell you didn't mean to add, just click on it again and you'll remove it from the region. Once you've finished a region, if you discover an error you can always remove regions in the reverse order in which they were defined by clicking on the discard last region button. Once the last region is finished, the data is sent to the server and the response is received and displayed. That's all there is to it!

Now that we know what we want to do, let's do it. As usual, I'll start at the bottom by first describing the types that we will use.

Shared Types

For starters, lets get the declarations and imports out of the way.

«sharedTypes imports»
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE BangPatterns             #-}

module Calcudoku.SharedTypes where

import Data.Text ( Text, empty )
import Data.Data ( Data, Typeable )
#ifdef FAY
import Data.Var
instance Read Text -- Sadly this was left out of Data.Text in fay-base
type World = Ref W
type UpdateW a = W -> a -> W
#endif

«sharedTypes Coord»
type Row = Int
type Column = Int
type Value = Int
type Coord = (Row, Column)
type Should a = Either Text a

cRow :: Coord -> Row
cRow (row,_) = row

cColumn :: Coord -> Column
cColumn (_,col) = col

mkC :: Row -> Column -> Coord
mkC x1 x2 = (x1,x2)

The Subscriber PuzzleType constructor was an afterthought, and is not used in the Fay Client portion of the code. It us used in case the user tries to parse a puzzle from the calcudoku.org website that is for subscibers only.

«sharedTypes Region»
data Operation          = Plus   | Minus  | Times  | Divide | Power
                        | Or     | And    |  Mod   | Id     | Empty
  deriving (Data, Eq, Read, Show, Typeable)

defaultPuzzleType :: PuzzleType
defaultPuzzleType = NullP

data PuzzleType         = Single | Double | Killer | Subscriber | NullP
  deriving (Data, Eq, Read, Show, Typeable)

data Region             = Region {
  regionResult           :: !Value,
  regionOperation        :: !Operation,
  regionCoords           :: ![Coord] }
  deriving (Data, Eq, Read, Show, Typeable)

emptyRegion :: Region
emptyRegion = Region 0 Empty []

Constraints are just lists of Regions, and a Board is a collection of data that totally defines the puzzle. Board is the important Data type that is shared between the client and the server.

«sharedTypes Board»
data Constraints        = Constraints
  { regions             :: ![Region] }
  deriving (Data, Eq, Read, Show, Typeable)

data Board              = Board {
  puzzleType            :: !PuzzleType,
  puzzleSide            :: !Int,
  puzzleElementRange    :: ![Int],
  puzzleConstraints     :: !(Constraints,Constraints) }
  deriving (Data, Eq, Read, Show, Typeable)
  -- puzzleConstraints is a tuple because when we solve a Double PuzzleType
  -- we use flipConstraints to switch the constraints from one board
  -- to another.  Thus fst puzzleConstraints is the current list of Regions

defaultBoard :: Board
defaultBoard = Board NullP 0 [] (Constraints [], Constraints [])

«sharedTypes PuzzleMode»
data PuzzleMode =
  ModeToggleCell | ModeRemoveCell | ModeSelectRegion |  ModeChangeValue
  deriving (Data, Eq, Read, Show, Typeable)

«sharedTypes Shared»
data Shared = Shared {
    sharedBoard     :: !Board
  , sharedEvents    :: ![CEvent]
  , sharedIPAddress :: !Text
  , sharedURL       :: !Text
  , sharedActualURL :: !Text
  , sharedBgFile    :: !Text
  , sharedPosted    :: !Bool }
  deriving (Data, Eq, Read, Show, Typeable)

-- For some unknown reason, if this is defined outside of main
-- the JSON version of this data turns "" of type Text into an
-- empty array.

defaultText :: Text
defaultText = Data.Text.empty

defaultShared :: Shared
defaultShared = Shared defaultBoard [] defaultText defaultText defaultText defaultText True

Client Types

After running this for a few days, I started getting emails that the puzzle didn't have a solution. I needed a way for the user to be able to send me the data that he input, so I could take a look at it. That required a new datatype, the CEvent. Each CEvent corresponds to a user's action. By replaying the user input, I can debug anything that goes wrong in the Fay code, as well as make sure the solver is running correctly. So far, all of the errors have been mistakes on the data entry part. This means I need to rethink how to make the data entry simpler and need to figure out a convenient way to edit already entered data.

«clientTypes World»
data W = W {
    board                 :: !Board      -- The puzzle board
  , currentRegionIndex    :: Maybe Int   -- If we have a current region
                                         -- this is the index into the
                                         -- puzzleConstraints list
  , editing               :: !PuzzleMode -- the current editing mode
  , cevents               :: ![CEvent]   -- a list of user generated
                                         -- browser events
    }
  deriving (Data, Eq, Read, Show, Typeable)

defaultW :: W
defaultW = W (Board NullP 0 [] (Constraints [],Constraints [])) Nothing ModeToggleCell []

«sharedTypes CEvent»
data CEvent =
               P PuzzleType Int [Int]   -- Type Size Range
             | D Int Int                -- Discard region containing x,y
             | L Int Int                -- l on cell x y
             | M PuzzleMode             -- change editing mode
             | R (Maybe Int)            -- change current region
             | V Operation Int          -- change op and value of region
             | N Int Int Operation Int  -- add a new region

  deriving (Data, Eq, Read, Show, Typeable)

Maps

«maps definitions»
valueToOperationMap :: [(Text, Operation)]
valueToOperationMap = [
      ("Id"    , Id)
    , ("Plus"  , Plus)
    , ("Minus" , Minus)
    , ("Times" , Times)
    , ("Divide", Divide)
    , ("Power" , Power)
    , ("Mod"   , Mod)
    , ("And"   , And)
    , ("Or"    , Or)
    , ("Empty" , Empty)
  ]

valueToOperationTextMap :: [(Text, Text)]
valueToOperationTextMap = [
     ("", "Select operator for region")
        , ("Id"     , "=")
        , ("Plus"   , "+")
        , ("Minus"  , "-")
        , ("Times"  , "*")
        , ("Divide" , "/")
        , ("Power"  , "^")
        , ("Mod"    , "mod")
        , ("And"    , "&")
        , ("Or"     , "|")
  ]

operationToTextMap :: [(Operation, Text)]
operationToTextMap = [
          (Id     , "=")
        , (Plus   , "+")
        , (Minus  , "-")
        , (Times  , "*")
        , (Divide , "/")
        , (Power  , "^")
        , (Mod    , "mod")
        , (And    , "&")
        , (Or     , "|")
  ]

-- valueToOperationTextMap :: [(Text, Text)]
-- valueToOperationTextMap = [
--      ("", "Select operator for region")
--         , ("Id"     , "=")
--         , ("Plus"   , "+")
--         , ("Minus"  , "-")
--         , ("Times"  , "×")
--         , ("Divide" , "÷")
--         , ("Power"  , "^")
--         , ("Mod"    , "mod")
--         , ("And"    , "∧")
--         , ("Or"     , "∨")
--   ]
-- 
-- operationToTextMap :: [(Operation, Text)]
-- operationToTextMap = [
--           (Id     , "=")
--         , (Plus   , "+")
--         , (Minus  , "-")
--         , (Times  , "*")
--         , (Divide , "/")
--         , (Power  , "^")
--         , (Mod    , "%")
--         , (And    , "&")
--         , (Or     , "|")
--   ]

xoperationToTextMap :: [(Operation,Text)]
xoperationToTextMap =
  let
    textOps = 
      map (\x -> fromMaybe (error . unpack $ "Missing op")
        (lookup x valueToOperationTextMap)) (map fst valueToOperationMap)
    opNames = map snd valueToOperationMap
    in zip opNames textOps

«maps puzzleMaps»
puzzleTypeMap :: [(Text, PuzzleType)]
puzzleTypeMap = [
    ("Single"     , Single)
  , ("Double"     , Double)
  , ("Killer"     , Killer)
  , ("Subscriber" , Subscriber)
  , ("NullP"      , NullP)]

puzzleModeMap :: [(Text, PuzzleMode)]
puzzleModeMap = [
     ( "ModeToggleCell"   ,  ModeToggleCell )
  ,  ( "ModeRemoveCell"   ,  ModeRemoveCell )
  ,  ( "ModeSelectRegion" ,  ModeSelectRegion )
  ,  ( "ModeChangeValue"  ,  ModeChangeValue ) 
  ]

explainMap :: [(PuzzleType, Text)]
explainMap = [
      (Single , "#explainCreateRegion")
    , (Double , "#explainCreateRegion")
    , (Killer , "#explainKillerCreateRegion") ]

Updaters

So a World is a reference to a W, and and UpdateW is a function that updates a subfield of a W. Here are all the various updaters we need. Makes you appreciate Lenses, which aren't available in Fay.

«updaters code»
updateSide :: UpdateW Int
updateSide w v = w { board = (board w) { puzzleSide = v}}
updatePuzzleType :: UpdateW PuzzleType 
updatePuzzleType w v = w { board = (board w) { puzzleType = v}}
updateElementRange :: UpdateW [Int]
updateElementRange w v = w { board = (board w) { puzzleElementRange = v}}

updateLow :: UpdateW Int
updateLow w v = w { board = (board w)
 { puzzleElementRange = [v .. (Prelude.last . puzzleElementRange . board $ w)]}}
updateHigh :: UpdateW Int
updateHigh w v = w { board = (board w)
 { puzzleElementRange = [(Prelude.head . puzzleElementRange . board $ w) .. v]}}
updateAll w v = w { board = (board w) { puzzleSide = v, puzzleElementRange = [1..v] }}

currentRegion :: W -> Region
currentRegion w =
  maybe (tError "currentRegion is Nothing") thisRegion (currentRegionIndex w)
  where
    thisRegion i = (regions $ currentConstraints w) !! i

currentConstraints :: W -> Constraints
currentConstraints w = fst . puzzleConstraints . board $ w

currentRegionCoords :: W -> [Coord]
currentRegionCoords w = maybe [] theseCoords (currentRegionIndex w)
  where
    theseCoords _ = regionCoords . currentRegion $ w

updateCurrentRegion :: UpdateW Region
updateCurrentRegion w r =
  let
    b = board w
    allRegions = regions . currentConstraints $ w
    newW = case (currentRegionIndex w) of
      Nothing -> 
        let
          newRegions = r : allRegions
          newC = (Constraints newRegions , snd (puzzleConstraints b))
          newB = b { puzzleConstraints = newC }
        in w { board = newB, currentRegionIndex = Just 0 }
      Just i ->
        let
          regionIsEmpty = Prelude.null . regionCoords
          (before,after) = splitAt i allRegions
          newRegions = if regionIsEmpty r then before ++ (Prelude.tail after)
                         else before ++ [r] ++ (Prelude.tail after)
          newC = (Constraints newRegions , snd (puzzleConstraints b))
          newB = b { puzzleConstraints = newC }
          w1 = if regionIsEmpty r then w { currentRegionIndex = Nothing } else w
          w2 = w1 { board = newB }
        in w2
    in newW

isNewRegion :: W -> Bool
isNewRegion w = maybe True (const False) (currentRegionIndex w)

removeEmptyRegions :: W -> W
removeEmptyRegions w =
  let
    b = board w
    allRegions :: W -> [Region]
    allRegions = regions . currentConstraints
    nonEmptyRegions :: W -> [Region]
    nonEmptyRegions = filter hasCells . allRegions
    hasCells :: Region -> Bool
    hasCells  = not . Prelude.null . regionCoords
    newB = b { puzzleConstraints = (Constraints (nonEmptyRegions w)
                                   , snd (puzzleConstraints b)) }
    newW = w { board = newB }
  in newW

Picklers

So here is the GHC/Fay compatibility layer. It encodes/decodes Text, Ints, Lists of Ints, and Bools. Everything else is express in terms of it.

«pickle compat»
#ifdef FAY
unwords :: [Text] -> Text
unwords = ffi "%1.join(\" \")"
#else
unwords :: [Text] -> Text
unwords = Data.Text.unwords
#endif

decodeBool :: Text -> Bool
decodeBool x = x == "True" || x == "true"

#ifdef FAY
encodeInt :: Int -> Text
encodeInt = ffi "JSON.stringify(%1)"
decodeInt :: Text -> Int
decodeInt = ffi "parseInt(%1)"
decodeIntList :: Text -> [Int]
decodeIntList = ffi "JSON.parse(%1)"
encodeIntList :: [Int] -> Text
encodeIntList = ffi "JSON.stringify(%1)"
encodeBool :: Bool -> Text
encodeBool b = if b then "true" else "false"
sortIntList :: [(Int,Int)] -> [(Int,Int)]
sortIntList = ffi "%1.sort(  (function(x,y) { \
  \ if (x[0] == y[0]) {return (x[1]-y[1])} else {return (x[0]-y[0])} ;}))"
#else

decodeFromText :: Read a => Text -> a
decodeFromText = read . unpack
encodeInt :: Int -> Text
encodeInt = pack . show
decodeInt :: Text -> Int
decodeInt = decodeFromText
decodeIntList :: Text -> [Int]
decodeIntList = decodeFromText
encodeIntList :: [Int] -> Text
encodeIntList = pack . show
encodeBool :: Bool -> Text
encodeBool = pack . show
sortIntList :: [(Int,Int)] -> [(Int,Int)]
sortIntList = sort
deblank :: Text -> Text
deblank = Data.Text.filter nonWhiteSpace
  where
    nonWhiteSpace c = not (c `Prelude.elem` whiteSpace)

#endif

«pickle chars»
comma, underscore, space, newLine :: Text
comma = ","
underscore = "_"
space = " "
newLine = "\n"
whiteSpace :: [Char]
whiteSpace = [ ' ', '\n', '\t' ]

«pickle text»
encodeSafeTextList :: [Text] -> Text
encodeSafeTextList = encloseWith "[]" . (Data.Text.intercalate (comma <> newLine))
decodeSafeTextList :: Text -> [Text]
decodeSafeTextList = balancedBreakText comma . deEnclose

«pickle code»
encloseWith :: Text -> Text -> Text
encloseWith brackets txt = Data.Text.head brackets `cons` txt `snoc` Data.Text.last brackets

deEnclose :: Text -> Text
deEnclose = Data.Text.init . Data.Text.tail

deList :: Text -> [Text]
deList = Data.Text.splitOn comma . deEnclose
               
encodeIntPair :: (Int,Int) -> Text
encodeIntPair (x,y) = encloseWith "()" (encodeInt x <> comma <> encodeInt y)
decodeIntPair :: Text -> (Int,Int)
decodeIntPair txt = if confirm then (decodeInt i1, decodeInt i2) else errorT "decodeIntPair"
  where
    (p1,r1) = maybe (errorT "decodeIntPair") id (uncons txt)
    (i1,t2) = only2 (splitOn comma r1)
    i2 = Data.Text.init t2
    p2 = Data.Text.last t2
    confirm = p1 == '(' && p2 == ')' 

-- !!! Note !!! the IntPairList that comes out of encode is SORTED
encodeIntPairList :: [(Int,Int)] -> Text
encodeIntPairList ps = encloseWith "[]" (Data.Text.intercalate comma (Prelude.map encodeIntPair . sortIntList $ ps))
decodeIntPairList :: Text -> [(Int,Int)]
decodeIntPairList = Prelude.map decodeIntPair . joinTextPairs . deList
  where
    joinTextPairs :: [Text] -> [Text]
    joinTextPairs txts = go [] txts
      where
        go acc [] = Prelude.reverse acc
        go acc (x:y:rest) = go (x<>comma<>y:acc) rest
        go acc rest = error . unpack . unwords  $ ["joinTextPairs:"] ++ acc ++ rest


unEither :: Either c c -> c
unEither = either id id
unLeft :: Either Text c -> c
unLeft = either (\x -> (errorT ("unLeft " <> x))) id

balancedBreakText :: Text -> Text -> [Text]
balancedBreakText delimiterText text = Prelude.map pack result
  where
    result = balancedBreak (unpack delimiterText) (unpack text)

encodeOperation :: Operation -> Text
encodeOperation = unEither . showLookup "encodeOperation error "  valueToOperationMap
decodeOperation :: Text -> Operation
decodeOperation = unLeft . readLookup "decodeOperation error " valueToOperationMap

encodePuzzleType :: PuzzleType -> Text
encodePuzzleType = unEither . showLookup "encodePuzzleType error " puzzleTypeMap
decodePuzzleType :: Text -> PuzzleType
decodePuzzleType = unLeft . readLookup "decodePuzzleType error " puzzleTypeMap

encodePuzzleMode :: PuzzleMode -> Text
encodePuzzleMode = unEither . showLookup "encodePuzzleMode error " puzzleModeMap
decodePuzzleMode :: Text -> PuzzleMode
decodePuzzleMode = unLeft . readLookup "decodePuzzleMode error " puzzleModeMap

encodeCEvent :: CEvent -> Text
encodeCEvent cev = case cev of
  P x1 x2 x3  -> Data.Text.intercalate underscore
    [ "P" , encodePuzzleType x1, encodeInt x2, encodeIntList x3 ]
  L x1 x2     -> encodeWith2Ints "L" x1 x2
  D x1 x2     -> encodeWith2Ints "D" x1 x2
  M x1        -> "M_" <> encodePuzzleMode x1
  R Nothing   -> "R_N"
  R (Just x1) -> "R_J_" <> encodeInt x1
  V x1 x2     -> Data.Text.intercalate underscore
    [ "V" , encodeOperation x1, encodeInt x2]
  N x1 x2 x3 x4 -> Data.Text.intercalate underscore
    [ "N", encodeInt x1, encodeInt x2, encodeOperation x3, encodeInt x4 ]
  where
    encodeWith2Ints str i1 i2 = Data.Text.intercalate underscore
      [ str , encodeInt i1, encodeInt i2]

cEventMap :: [(Text, [Text] -> CEvent)]
cEventMap = [
    ("P" , \x -> P (decodePuzzleType (x!!1)) (decodeInt (x!!2)) (decodeIntList (x!!3)) )
  , ("L" , \x -> L (decodeInt (x!!1)) (decodeInt (x!!2)) )
  , ("D" , \x -> D (decodeInt (x!!1)) (decodeInt (x!!2)) )
  , ("M" , \x -> M (decodePuzzleMode (x!!1)) )
  , ("R" , \x -> R (if (x!!1) == "N" then Nothing else Just (decodeInt (x!!2))) )
  , ("V" , \x -> V (decodeOperation (x!!1)) (decodeInt (x!!2)) )
  , ("N" , \x -> N (decodeInt (x!!1)) (decodeInt (x!!2)) (decodeOperation (x!!3)) (decodeInt (x!!4)) ) ]

decodeCEvent :: Text -> CEvent
decodeCEvent txt = case mbF of
  Nothing -> errorT ("Nothing in decodeCEvent: " <> txt)
  Just f  -> f  splitted
  where
    splitted = splitOn underscore txt
    mbFF [] = errorT ("Null in decodeCEvent: " <> txt)
    mbFF (x:_) = lookup x cEventMap
    mbF = mbFF splitted

encodeCEvents :: [CEvent] -> Text
encodeCEvents =  encloseWith "[]" . Data.Text.intercalate comma . (Prelude.map encodeCEvent)
decodeCEvents :: Text -> [CEvent]
decodeCEvents txt = if cs == [""] then [] else  Prelude.map decodeCEvent $ cs
  where
    cs = balancedBreakText comma . deEnclose $ txt

encodeRegion :: Region -> Text
encodeRegion (Region v o cs) = "Region_" <>
  Data.Text.intercalate underscore
    [encodeInt v, encodeOperation o, encodeIntPairList cs]

decodeRegion :: Text -> Region
decodeRegion txt = (confirm region) (decodeInt result) (decodeOperation op) (decodeIntPairList coords)
  where
    (region,result,op,coords) = only4 . splitOn underscore $ txt
    confirm x = if x == "Region" then Region else errorT ("decodeRegion: " <> txt)

encodeConstraint :: Constraints -> Text
encodeConstraint (Constraints cs) =
  "Con_" <> encloseWith "[]" (Data.Text.intercalate comma (Prelude.map encodeRegion cs))
decodeConstraint :: Text -> Constraints
decodeConstraint txt = (confirm constraint) (Prelude.map decodeRegion regs)
  where
    (constraint,rs) = (Data.Text.take 4 txt, Data.Text.drop 4 txt)
    regs = if rs == "[]" then [] else balancedBreakText comma . deEnclose $ rs
    confirm x = if x == "Con_" then Constraints else errorT ("decodeConstraints: " <> txt)

toTuple :: [a] -> (a,a)
toTuple []    = errorT "toTuple got null"
toTuple [a]   = (a,a)
toTuple [a,b] = (a,b)
toTuple _     = errorT "toTuple got more than two"

encodeConstraints :: (Constraints,Constraints) -> Text
encodeConstraints (c1,c2) = encloseWith "()" . (Data.Text.intercalate comma) $
  [encodeConstraint c1, encodeConstraint c2]

decodeConstraints :: Text -> (Constraints,Constraints)
decodeConstraints c1c2 = (decodeConstraint c1, decodeConstraint c2)
  where
    cs = balancedBreakText comma . deEnclose $ c1c2
    (c1,c2) = toTuple cs

encodeBoard :: Board -> Text
encodeBoard (Board pt ps pe pc) =  encloseWith "[]" . (Data.Text.intercalate comma) $
    [ "Bo", encodePuzzleType pt, encodeInt ps, encodeIntList pe, encodeConstraints pc]
decodeBoard :: Text -> Board
decodeBoard txt =  ((confirm bo) (decodePuzzleType pt) (decodeInt ps) (decodeIntList pe) (decodeConstraints pc))
   where
     (bo, pt, ps, pe, pc) =  only5 . balancedBreakText comma . deEnclose $ txt
     confirm x = if x == "Bo" then Board else errorT ("decodeBoard: " <> txt)

encodeShared :: Shared -> Text
encodeShared (Shared bd cs t1 t2 t3 t4 b) = encodeSafeTextList $
  (["Sh", encodeBoard bd, encodeCEvents cs] ++ 
   [encodeSafeTextList [t1,t2,t3,t4]] ++ [encodeBool b])
decodeShared :: Text -> Shared
decodeShared txt = (confirm sh) (decodeBoard bd) (decodeCEvents cs) t1 t2 t3 t4 (decodeBool b)
  where
    (sh, bd, cs, txts, b) = only5 . decodeSafeTextList . deblank $ txt
    (t1, t2, t3, t4) = only4 . decodeSafeTextList $ txts
    confirm x = if x == "Sh" then Shared else errorT ("decodeShared: " <> txt)

only2 :: Show b => [b] -> (b, b)
only2 [a,b] = (a,b)
only2 x     = errorT . unwords $ ["only2", "[", pack . show $ x, "]"]

only4 :: Show d => [d] -> (d, d, d, d)
only4 [a,b,c,d] = (a,b,c,d)
only4 x         = errorT . unwords $ ["only4", "[", pack . show $ x, "]"]

only5 :: Show e => [e] -> (e, e, e, e, e)
only5 [a,b,c,d,e] = (a,b,c,d,e)
only5 x         = errorT . unwords $ ["only5", "[", pack . show $ x, "]"]

«pickle test»
r1 = Region 1 Plus [(1,2),(3,4)]
r2 = Region 2 Times [(4,5),(6,7)]
c1 = Constraints [r1,r2]
c2 = Constraints [r2,r1]
c3 = (c1,c2)
b1 = Board Single 3 [-1,0,1] (c1,c1)
b2 = Board Double 3 [-1,0,1] (c1,c2)
ce1 = P Single 1 [-1,0,1]
ce2 = D 1 2
ce3 = L 3 4
ce4 = M ModeChangeValue
ce5 = R (Just 1)
ce6 = V Divide 2
ce7 = N 1 2 Minus 3
ces = [ce1, ce2, ce3, ce4, ce5, ce6, ce7]
s1 = Shared b1 ces "127.0.0.1" "!^withHat1^" "!^withHat2^" "!^withHat3^" True
round1 = decodeRegion . encodeRegion 
round2 = decodeConstraints . encodeConstraints
round3 = decodeBoard . encodeBoard
round4 = decodeCEvent . encodeCEvent
round5 = decodeCEvents . encodeCEvents
round6 = decodeShared . encodeShared
#ifdef Fay
pickleTest :: Fay ()
#else
pickleTest :: IO ()
#endif
pickleTest = do
  print $ encodeConstraint c1
  print (round1 r1)
  print (round2 c3)
  print (round3 b1)
  print (encodeBoard b1)
  mapM_ print (Prelude.map  encodeCEvent ces)
  mapM_ print (Prelude.map round4 ces)
  print (encodeCEvents ces)
  mapM_ print $ (round5 ces)
  print (encodeShared s1)
  print (round6 s1)