diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,9 @@
+0.1.0.3: 20140519
+-----------------
+
+* add new puzzle types: Maximal Lengths, Prime Place, Magic Labyrinth
+
+
 0.1.0.2: 20140419
 -----------------
 
diff --git a/puzzle-draw.cabal b/puzzle-draw.cabal
--- a/puzzle-draw.cabal
+++ b/puzzle-draw.cabal
@@ -1,5 +1,5 @@
 name:                puzzle-draw
-version:             0.1.0.2
+version:             0.1.0.3
 synopsis:            Creating graphics for pencil puzzles.
 description:         puzzle-draw is a library for drawing pencil puzzles
                      using Diagrams. It aims to provide a utility layer
diff --git a/src/Data/Puzzles/Compose.hs b/src/Data/Puzzles/Compose.hs
--- a/src/Data/Puzzles/Compose.hs
+++ b/src/Data/Puzzles/Compose.hs
@@ -63,6 +63,9 @@
 handle f Tapa                 = f R.tapa                D.tapa
 handle f JapaneseSums         = f R.japanesesums        D.japanesesums
 handle f Coral                = f R.coral               D.coral
+handle f MaximalLengths       = f R.maximallengths      D.maximallengths
+handle f PrimePlace           = f R.primeplace          D.primeplace
+handle f Labyrinth            = f R.labyrinth           D.labyrinth
 
 -- | Handler that parses a puzzle from a YAML value, and renders.
 drawPuzzle :: PuzzleHandler b (Value -> Parser (Diagram b R2))
diff --git a/src/Data/Puzzles/Elements.hs b/src/Data/Puzzles/Elements.hs
--- a/src/Data/Puzzles/Elements.hs
+++ b/src/Data/Puzzles/Elements.hs
@@ -58,3 +58,6 @@
 
 data JapVal = JapBlack | JapInt Int
     deriving Show
+
+-- | Diagonal marking for Prime Place: forward diag?, backward diag?
+newtype PrimeDiag = PrimeDiag (Bool, Bool)
diff --git a/src/Data/Puzzles/Grid.hs b/src/Data/Puzzles/Grid.hs
--- a/src/Data/Puzzles/Grid.hs
+++ b/src/Data/Puzzles/Grid.hs
@@ -44,6 +44,9 @@
 instance Traversable (Grid s) where
     traverse f (Grid s m) = Grid s <$> (traverse f m)
 
+filterG :: (a -> Bool) -> (Grid s a) -> (Grid s a)
+filterG p (Grid s m) = Grid s (Map.filter p m)
+
 -- | Initialize a square grid from a list of lists. The grid
 --   might be incomplete if some rows are shorter.
 fromListList :: [[a]] -> Grid Square a
diff --git a/src/Data/Puzzles/GridShape.hs b/src/Data/Puzzles/GridShape.hs
--- a/src/Data/Puzzles/GridShape.hs
+++ b/src/Data/Puzzles/GridShape.hs
@@ -3,6 +3,11 @@
 -- | Grid shapes.
 module Data.Puzzles.GridShape where
 
+import Data.Foldable (Foldable)
+import qualified Data.Foldable as F
+import Data.List (partition)
+import Data.VectorSpace ((^+^))
+
 -- | The geometry of a grid.
 class Show (Cell a) => GridShape a where
     type GridSize a :: *
@@ -12,7 +17,8 @@
     size :: a -> GridSize a
     cells :: a -> [Cell a]
     vertices :: a -> [Vertex a]
-    neighbours :: a -> Cell a -> [Cell a]
+    vertexNeighbours :: a -> Cell a -> [Cell a]
+    edgeNeighbours :: a -> Cell a -> [Cell a]
 
 -- | A standard square grid, with cells and vertices
 --   indexed by pairs of integers in mathematical coordinates.
@@ -21,6 +27,12 @@
 data Square = Square !Int !Int
     deriving Show
 
+squareNeighbours :: [(Int, Int)] -> Square -> (Cell Square) -> [Cell Square]
+squareNeighbours deltas (Square w h) c = filter inBounds . map (add c) $ deltas
+  where
+    inBounds (x, y) = x >= 0 && x < w && y >= 0 && y < h
+    add (x, y) (x', y') = (x + x', y + y')
+
 instance GridShape Square where
     type GridSize Square = (Int, Int)
     type Cell Square     = (Int, Int)
@@ -29,14 +41,15 @@
     size (Square w h)       = (w, h)
     cells (Square w h)      = [(x, y) | x <- [0..w-1], y <- [0..h-1]]
     vertices (Square w h)   = [(x, y) | x <- [0..w], y <- [0..h]]
-    neighbours (Square w h) c = filter inBounds . map (add c) $ deltas
-      where
-        inBounds (x, y) = x >= 0 && x < w && y >= 0 && y < h
-        deltas = [ (dx, dy)
-                 | dx <- [-1..1], dy <- [-1..1]
-                 , dx /= 0 || dy /= 0
-                 ]
-        add (x, y) (x', y') = (x + x', y + y')
+    vertexNeighbours = squareNeighbours [ (dx, dy)
+                                        | dx <- [-1..1], dy <- [-1..1]
+                                        , dx /= 0 || dy /= 0
+                                        ]
+    edgeNeighbours = squareNeighbours [ (dx, dy)
+                                      | dx <- [-1..1], dy <- [-1..1]
+                                      , dx /= 0 || dy /= 0
+                                      , dx == 0 || dy == 0
+                                      ]
 
 -- | Edge direction in a square grid, vertical or horizontal.
 data Dir = V | H
@@ -49,3 +62,39 @@
 
 type Coord = Cell Square
 type Size = GridSize Square
+
+-- | Oriented edge direction in a square grid.
+data Dir' = U | D | L | R
+    deriving (Eq, Ord, Show)
+
+-- | An oriented edge in a square grid.
+--   @a@ should be @Cell Square@ or @Vertex Square@.
+data Edge' a = E' a Dir'
+    deriving (Eq, Ord, Show)
+
+-- | The edge between two neighbouring cells, with the first cell
+--   on the left.
+orientedEdge :: (Cell Square) -> (Cell Square) -> (Edge' (Vertex Square))
+orientedEdge (x,y) (x',y')
+    | x' == x && y' == y+1  = E' (x,y+1) R
+    | x' == x && y' == y-1  = E' (x+1,y) L
+    | x' == x+1 && y' == y  = E' (x+1,y+1) D
+    | x' == x-1 && y' == y  = E' (x,y) U
+    | otherwise             = error $ "not neighbours: " ++
+                                      show (x,y) ++ " " ++  show (x',y')
+
+-- | @edges@ computes the outer and inner edges of a set of cells.
+--   The set is given via fold and membership predicate, the result
+--   is a pair @(outer, inner)@ of lists of edges, where the outer
+--   edges are oriented such that the outside is to the left.
+edges :: Foldable f =>
+           f (Cell Square) -> (Cell Square -> Bool) ->
+           ([Edge' (Vertex Square)], [Edge' (Vertex Square)])
+edges cs isc = F.foldr f ([], []) cs
+  where
+    f c (outer, inner) = (newout ++ outer, newin ++ inner)
+      where
+        nbrs = [ c ^+^ d | d <- [(-1,0), (0,1), (1,0), (0,-1)] ]
+        (ni, no) = partition isc nbrs
+        newout = map (orientedEdge c) no
+        newin = map (orientedEdge c) . filter ((>=) c) $ ni
diff --git a/src/Data/Puzzles/PuzzleTypes.hs b/src/Data/Puzzles/PuzzleTypes.hs
--- a/src/Data/Puzzles/PuzzleTypes.hs
+++ b/src/Data/Puzzles/PuzzleTypes.hs
@@ -37,6 +37,9 @@
                 | Tapa
                 | JapaneseSums
                 | Coral
+                | MaximalLengths
+                | PrimePlace
+                | Labyrinth
     deriving (Show, Eq)
 
 typeNames :: [(PuzzleType, String)]
@@ -66,6 +69,9 @@
             , (Tapa, "tapa")
             , (JapaneseSums, "japanesesums")
             , (Coral, "coral")
+            , (MaximalLengths, "maximallengths")
+            , (PrimePlace, "primeplace")
+            , (Labyrinth, "magiclabyrinth")
             ]
 
 -- | Look up a puzzle type by name.
diff --git a/src/Diagrams/Puzzles/Elements.hs b/src/Diagrams/Puzzles/Elements.hs
--- a/src/Diagrams/Puzzles/Elements.hs
+++ b/src/Diagrams/Puzzles/Elements.hs
@@ -158,3 +158,12 @@
     p' 4 = reflectX . rotateBy (3/8) $ square 0.7
     p' 1 = error "singleton clues handled separately"
     p' _ = error "invalid tapa clue"
+
+drawPrimeDiag :: (Backend b R2, Renderable (Path R2) b) =>
+                 PrimeDiag -> Diagram b R2
+drawPrimeDiag (PrimeDiag d) = stroke p # lw (3 * onepix) # lc (blend 0.5 gray white)
+  where
+    p = case d of (False, False) -> mempty
+                  (True,  False) -> ur
+                  (False, True)  -> dr
+                  (True,  True)  -> ur <> dr
diff --git a/src/Diagrams/Puzzles/Grid.hs b/src/Diagrams/Puzzles/Grid.hs
--- a/src/Diagrams/Puzzles/Grid.hs
+++ b/src/Diagrams/Puzzles/Grid.hs
@@ -3,6 +3,7 @@
 module Diagrams.Puzzles.Grid where
 
 import Data.Char (isUpper)
+import qualified Data.Map as M
 
 import Diagrams.Prelude
 
@@ -22,13 +23,23 @@
 slithergrid (x, y) =
     hcatsep . replicate (x + 1) . vcatsep . replicate (y + 1) $ dot
 
+fence :: [Double] -> Double -> Path R2
+fence xs h = decoratePath xspath (repeat v)
+  where
+    xspath = fromVertices [ p2 (x, 0) | x <- xs ]
+    v = alignB (vrule h)
+
 -- | The inner grid lines of a square grid of the specified size.
 gridlines :: Size -> Path R2
-gridlines (w, h) = (decoratePath xaxis . repeat . alignB . vrule . fromIntegral $ h)
-            <> (decoratePath yaxis . repeat . alignL . hrule . fromIntegral $ w)
-    where xaxis = fromVertices [ p2 (fromIntegral x, 0) | x <- [1..w-1] ]
-          yaxis = fromVertices [ p2 (0, fromIntegral y) | y <- [1..h-1] ]
+gridlines (w, h) = fence' w h <> mirror (fence' h w)
+  where
+    fence' n l = fence (map fromIntegral [1..n-1]) (fromIntegral l)
 
+fullgridlines :: Size -> Path R2
+fullgridlines (w, h) = fence' w h <> mirror (fence' h w)
+  where
+    fence' n l = fence (map fromIntegral [0..n]) (fromIntegral l)
+
 -- | Draw a frame around the outside of a rectangle.
 outframe :: Renderable (Path R2) b => Size -> Diagram b R2
 outframe (w, h) = strokePointLoop r # lw fw
@@ -52,6 +63,11 @@
         Size -> Diagram b R2
 grid = grid' id
 
+-- | Draw a square grid with thin frame.
+plaingrid :: (Backend b R2, Renderable (Path R2) b) =>
+             Size -> Diagram b R2
+plaingrid s = stroke (fullgridlines s) # lw gridwidth
+
 bgdashing :: (Semigroup a, HasStyle a) =>
              [Double] -> Double -> Colour Double -> a -> a
 bgdashing ds offs c x = x # dashing ds offs <> x # lc c
@@ -70,6 +86,25 @@
 dashedgrid = grid' $ bgdashing dashes dashoffset white'
   where
     white' = blend 0.95 white black
+
+edgePath :: Edge' (Vertex Square) -> Path R2
+edgePath (E' v R) = p2i v ~~ p2i (v ^+^ (1,0))
+edgePath (E' v L) = p2i v ~~ p2i (v ^+^ (-1,0))
+edgePath (E' v U) = p2i v ~~ p2i (v ^+^ (0,1))
+edgePath (E' v D) = p2i v ~~ p2i (v ^+^ (0,-1))
+
+irregularGridPaths :: SGrid a -> (Path R2, Path R2)
+irregularGridPaths (Grid _ m) = (toPath outer, toPath inner)
+  where
+    (outer, inner) = edges (M.keysSet m) (flip M.member m)
+    toPath = mconcat . map edgePath
+
+irregularGrid :: (Backend b R2, Renderable (Path R2) b) =>
+                 SGrid a -> Diagram b R2
+irregularGrid g = stroke outer # lw (3 * gridwidth) # lineCap LineCapSquare <>
+                  stroke inner # lw gridwidth
+  where
+    (outer, inner) = irregularGridPaths g
 
 -- | In a square grid, use the first argument to draw things at the centres
 --   of cells given by coordinates.
diff --git a/src/Diagrams/Puzzles/Lib.hs b/src/Diagrams/Puzzles/Lib.hs
--- a/src/Diagrams/Puzzles/Lib.hs
+++ b/src/Diagrams/Puzzles/Lib.hs
@@ -38,6 +38,9 @@
 p2i :: (Int, Int) -> P2
 p2i = p2 . (fromIntegral *** fromIntegral)
 
+mirror :: (Transformable t, V t ~ R2) => t -> t
+mirror = reflectAbout (p2 (0, 0)) (r2 (1, 1))
+
 -- | Interleave two lists.
 interleave :: [a] -> [a] -> [a]
 interleave [] _ = []
diff --git a/src/Diagrams/Puzzles/PuzzleGrids.hs b/src/Diagrams/Puzzles/PuzzleGrids.hs
--- a/src/Diagrams/Puzzles/PuzzleGrids.hs
+++ b/src/Diagrams/Puzzles/PuzzleGrids.hs
@@ -84,6 +84,12 @@
   where
     if' a b x = if x then a else b
 
+
+outsideGrid :: (Backend b R2, Renderable (Path R2) b) =>
+               OutsideClues [String] -> Diagram b R2
+outsideGrid = atCentres (scale 0.8 . drawText) . multiOutsideClues
+              <> grid . outsideSize
+
 outsideIntGrid :: (Backend b R2, Renderable (Path R2) b) =>
                   OutsideClues [Int] -> Diagram b R2
 outsideIntGrid = atCentres (scale 0.8 . drawInt) . multiOutsideClues
diff --git a/src/Diagrams/Puzzles/PuzzleTypes.hs b/src/Diagrams/Puzzles/PuzzleTypes.hs
--- a/src/Diagrams/Puzzles/PuzzleTypes.hs
+++ b/src/Diagrams/Puzzles/PuzzleTypes.hs
@@ -7,7 +7,7 @@
     liarslither, tightfitskyscrapers, wordloop, wordsearch,
     curvedata, doubleback, slalom, compass, boxof2or3,
     afternoonskyscrapers, countnumbers, tapa, japanesesums,
-    coral,
+    coral, maximallengths, primeplace, labyrinth
   ) where
 
 import Diagrams.Prelude hiding (Loop, coral)
@@ -199,7 +199,32 @@
     japcell (JapInt x) = drawInt x
 
 coral :: (Backend b R2, Renderable (Path R2) b) =>
-                RenderPuzzle b (OutsideClues [Int]) ShadedGrid
+          RenderPuzzle b (OutsideClues [String]) ShadedGrid
 coral = (,)
-    outsideIntGrid
-    (drawShadedGrid . snd <> outsideIntGrid . fst)
+    outsideGrid
+    (drawShadedGrid . snd <> outsideGrid . fst)
+
+maximallengths :: (Backend b R2, Renderable (Path R2) b) =>
+                  RenderPuzzle b (OutsideClues (Maybe Int)) Loop
+maximallengths = (,)
+    g
+    (solstyle . drawDualEdges . snd <> g . fst)
+  where
+    g = atCentres drawInt . outsideClues
+        <> grid . outsideSize
+
+primeplace :: (Backend b R2, Renderable (Path R2) b) =>
+              RenderPuzzle b (SGrid PrimeDiag) (SGrid Int)
+primeplace = (,)
+    g
+    (atCentres drawInt . values . snd <> g . fst)
+  where
+    g = irregularGrid <> atCentres drawPrimeDiag . values
+
+labyrinth :: (Backend b R2, Renderable (Path R2) b) =>
+             RenderPuzzle b (SGrid (Clue Int), [Edge]) (SGrid (Clue Int))
+labyrinth = (,)
+    (atCentres drawInt . clues . fst <> g)
+    (atCentres drawInt . clues . snd <> g . fst)
+  where
+    g = drawEdges . snd <> plaingrid . size . fst
diff --git a/src/Text/Puzzles/PuzzleTypes.hs b/src/Text/Puzzles/PuzzleTypes.hs
--- a/src/Text/Puzzles/PuzzleTypes.hs
+++ b/src/Text/Puzzles/PuzzleTypes.hs
@@ -6,6 +6,7 @@
     liarslither, tightfitskyscrapers, wordloop, wordsearch,
     curvedata, doubleback, slalom, compass, boxof2or3,
     afternoonskyscrapers, countnumbers, tapa, japanesesums, coral,
+    maximallengths, primeplace, labyrinth
   ) where
 
 import Prelude hiding (sequence)
@@ -129,5 +130,15 @@
 japanesesums :: ParsePuzzle (OutsideClues [Int]) (SGrid JapVal)
 japanesesums = (parseMultiOutsideClues, parseGrid)
 
-coral :: ParsePuzzle (OutsideClues [Int]) ShadedGrid
+coral :: ParsePuzzle (OutsideClues [String]) ShadedGrid
 coral = (parseMultiOutsideClues, parseShadedGrid)
+
+maximallengths :: ParsePuzzle (OutsideClues (Maybe Int)) Loop
+maximallengths = (\v -> fmap blankToMaybe <$> parseCharOutside v,
+                  parseEdges)
+
+primeplace :: ParsePuzzle (SGrid PrimeDiag) (SGrid Int)
+primeplace = (parseIrregGrid, parseIrregGrid)
+
+labyrinth :: ParsePuzzle (SGrid (Clue Int), [Edge]) (SGrid (Clue Int))
+labyrinth = (parseCellEdges, parseClueGrid')
diff --git a/src/Text/Puzzles/Util.hs b/src/Text/Puzzles/Util.hs
--- a/src/Text/Puzzles/Util.hs
+++ b/src/Text/Puzzles/Util.hs
@@ -36,6 +36,9 @@
 class FromString a where
     parseString :: String -> Parser a
 
+parseLine :: FromChar a => String -> Parser [a]
+parseLine = mapM parseChar
+
 instance FromChar Int where
     parseChar c
         | isDigit c  = digitToInt <$> parseChar c
@@ -114,11 +117,6 @@
         p = sequence . map (mapM (parseString . T.unpack)) $ ls
     parseJSON _          = empty
 
-instance FromChar MasyuPearl where
-    parseChar '*' = pure MBlack
-    parseChar 'o' = pure MWhite
-    parseChar _   = empty
-
 data Space = Space
 
 instance FromChar Space where
@@ -127,6 +125,7 @@
 
 data Blank = Blank
 data Blank' = Blank'
+data Empty = Empty
 
 instance FromChar Blank where
     parseChar '.' = pure Blank
@@ -137,10 +136,25 @@
     parseChar '-' = pure Blank'
     parseChar _   = empty
 
+instance FromChar Empty where
+    parseChar ' ' = pure Empty
+    parseChar _   = empty
+
 instance FromString Blank where
     parseString "." = pure Blank
     parseString _   = empty
 
+data PlainNode = PlainNode
+
+instance FromChar PlainNode where
+    parseChar 'o' = pure PlainNode
+    parseChar _   = empty
+
+instance FromChar MasyuPearl where
+    parseChar '*' = pure MBlack
+    parseChar 'o' = pure MWhite
+    parseChar _   = empty
+
 instance FromChar SlalomDiag where
     parseChar '/'  = pure SlalomForward
     parseChar '\\' = pure SlalomBackward
@@ -165,9 +179,25 @@
 rectToSGrid :: Rect a -> SGrid a
 rectToSGrid (Rect w h ls) = Grid (Square w h) (listListToMap ls)
 
+blankToMaybe :: Either Blank a -> Maybe a
+blankToMaybe = either (const Nothing) Just
+
+blankToMaybe' :: Either Blank' a -> Maybe a
+blankToMaybe' = either (const Nothing) Just
+
 rectToClueGrid :: Rect (Either Blank a) -> SGrid (Clue a)
-rectToClueGrid = fmap (either (const Nothing) Just) . rectToSGrid
+rectToClueGrid = fmap blankToMaybe . rectToSGrid
 
+rectToClueGrid' :: Rect (Either Blank' a) -> SGrid (Clue a)
+rectToClueGrid' = fmap blankToMaybe' . rectToSGrid
+
+rectToIrregGrid :: Rect (Either Empty a) -> SGrid a
+rectToIrregGrid = fmap fromRight . filterG isRight . rectToSGrid
+  where
+    isRight = either (const False) (const True)
+    fromRight (Right r) = r
+    fromRight _         = error "no way"
+
 newtype Shaded = Shaded { unShaded :: Bool }
 
 instance FromChar Shaded where
@@ -184,6 +214,12 @@
 parseClueGrid :: FromChar a => Value -> Parser (SGrid (Clue a))
 parseClueGrid v = rectToClueGrid <$> parseJSON v
 
+parseClueGrid' :: FromChar a => Value -> Parser (SGrid (Clue a))
+parseClueGrid' v = rectToClueGrid' <$> parseJSON v
+
+parseIrregGrid :: FromChar a => Value -> Parser (SGrid a)
+parseIrregGrid v = rectToIrregGrid <$> parseJSON v
+
 parseSpacedClueGrid :: FromString a => Value -> Parser (SGrid (Clue a))
 parseSpacedClueGrid v = rectToClueGrid . unSpaced <$> parseJSON v
 
@@ -215,6 +251,38 @@
 parseGridChars :: FromChar a => SGrid Char -> Parser (SGrid a)
 parseGridChars = traverse parseChar
 
+-- | Parse a grid with edges and values at nodes and in cells.
+--
+-- E.g. o-*-*-o
+--      |1|2 3
+--      *-o
+-- to a grid of masyu pearls, a grid of integers, and some edges.
+parseEdgeGrid :: (FromChar a, FromChar b) =>
+                 Value -> Parser (SGrid a, SGrid b, [Edge])
+parseEdgeGrid v = uncurry (,,) <$>
+                  parseBoth <*>
+                  parsePlainEdges v
+  where
+    parseBoth = do
+        g <- parseGrid v
+        (gn, gc) <- halveGrid g
+        gn' <- parseGridChars gn
+        gc' <- parseGridChars gc
+        return (gn', gc')
+    both f (x, y) = (f x, f y)
+    halveGrid (Grid (Square w h) m)
+        | odd w && odd h = pure $ (Grid snode mnode, Grid scell mcell)
+        | otherwise      = empty
+      where
+        w' = (w + 1) `div` 2
+        h' = (h + 1) `div` 2
+        snode = Square w' h'
+        scell = Square (w' - 1) (h' - 1)
+        (mnode, mcell) =
+            both (Map.mapKeys (both (`div` 2))) .
+            Map.partitionWithKey (const . uncurry (&&) . both even) $
+            m
+
 -- | Parse a grid of edges with values at the nodes.
 --
 -- E.g. o-*-*-o
@@ -223,20 +291,18 @@
 -- to a grid of masyu pearls and some edges.
 parseNodeEdges :: FromChar a =>
                   Value -> Parser (SGrid a, [Edge])
-parseNodeEdges v = (,) <$>
-                   (parseGridChars =<< halveGrid =<< parseGrid v) <*>
-                   parsePlainEdges v
+parseNodeEdges v = proj13 <$> parseEdgeGrid v
   where
-    halveGrid (Grid (Square w h) m)
-        | odd w && odd h = pure $ Grid s' m'
-        | otherwise      = empty
-      where
-        s' = Square ((w + 1) `div` 2) ((h + 1) `div` 2)
-        m' = Map.mapKeys (both (`div` 2))
-           . Map.filterWithKey (const . (uncurry (&&) . both even))
-           $ m
-        both f (x, y) = (f x, f y)
+    proj13 :: (SGrid a, SGrid Empty, [Edge]) -> (SGrid a, [Edge])
+    proj13 (x,_,z) = (x,z)
 
+parseCellEdges :: FromChar a =>
+                  Value -> Parser (SGrid a, [Edge])
+parseCellEdges v = proj23 <$> parseEdgeGrid v
+  where
+    proj23 :: (SGrid PlainNode, SGrid a, [Edge]) -> (SGrid a, [Edge])
+    proj23 (_,y,z) = (y,z)
+
 data HalfDirs = HalfDirs {unHalfDirs :: [Dir]}
 
 instance FromChar HalfDirs where
@@ -288,10 +354,10 @@
         []   -> pure Nothing
         [q]  -> pure (Just q)
         _    -> fail "multiple successors"
-    succs      p = filter    (test ((==) . succ) p) . neighbours s $ p
-    isStart    p = not . any (test ((==) . pred) p) . neighbours s $ p
+    succs      p = filter    (test ((==) . succ) p) . vertexNeighbours s $ p
+    isStart    p = not . any (test ((==) . pred) p) . vertexNeighbours s $ p
     test f p q = maybe False (f (m' Map.! p)) (Map.lookup q m')
-    isAlmostIsolated p = all disjointSucc . neighbours s $ p
+    isAlmostIsolated p = all disjointSucc . vertexNeighbours s $ p
       where
         disjointSucc q = null $ intersect (succs p) (succs' q)
         succs' q = maybe [] (const $ succs q) (Map.lookup q m')
@@ -408,10 +474,30 @@
                      guard $ length xs > 0 && length xs <= 4
                      return . ParseTapaClue . TapaClue $ xs
 
+reorientOutside :: OutsideClues a -> OutsideClues a
+reorientOutside (OC l r b t) = OC (reverse l) (reverse r) b t
+
+parseCharOutside :: FromChar a => Value -> Parser (OutsideClues a)
+parseCharOutside (Object v) = reorientOutside <$>
+                              (OC <$>
+                               pfield "left" <*> pfield "right" <*>
+                               pfield "bottom" <*> pfield "top" )
+  where
+    pfield f = parseLine . fromMaybe [] =<< v .:? f
+parseCharOutside _          = empty
+
 parseMultiOutsideClues :: FromJSON a => Value -> Parser (OutsideClues [a])
 parseMultiOutsideClues (Object v) = rev <$> raw
   where
     raw = OC <$> v `ml` "left" <*> v `ml` "right" <*> v `ml` "bottom" <*> v `ml` "top"
     v' `ml` k = fromMaybe [] <$> v' .:? k
-    rev (OC l r b t) = OC (reverse . map reverse $ l) (reverse r) b (map reverse t)
+    rev (OC l r b t) = reorientOutside $
+                       OC (map reverse l) r b (map reverse t)
 parseMultiOutsideClues _ = empty
+
+instance FromChar PrimeDiag where
+    parseChar '.'  = pure $ PrimeDiag (False, False)
+    parseChar '/'  = pure $ PrimeDiag (True,  False)
+    parseChar '\\' = pure $ PrimeDiag (False, True)
+    parseChar 'X'  = pure $ PrimeDiag (True,  True)
+    parseChar _    = empty