added PathSegment type to simplify path generation

.nvmrc

@@ -0,0 +1 @@
+lts/iron

src/Game/Board/EvaluableBoard.purs

@@ -57,7 +57,7 @@ import Game.Capacity (Capacity, clampSignal)
 import Game.Direction (CardinalDirection, allDirections, clockwiseRotation, oppositeDirection)
 import Game.Direction as Direction
 import Game.Location (Location(..), followDirection)
-import Game.Piece (Piece(..), PieceId(..))
+import Game.Piece (Piece(..), PieceId(..), mkPiece)
 import Game.Piece as Complexity
 import Game.Port (Port(..), inputPort, isInput, isOutput, matchingPort, outputPort, portCapacity)
 import Game.PortInfo (PortInfo, getClampedSignal)
@@ -147,7 +147,7 @@ topologicalSort nodes edges = do
   Cons r <$> topologicalSort nodes' edges'
 
 evaluableBoardPiece :: EvaluableBoard -> Piece
-evaluableBoardPiece evaluable@(EvaluableBoard e) = Piece
+evaluableBoardPiece evaluable@(EvaluableBoard e) = mkPiece
   { name: PieceId "evaluable"
   , eval:
       \inputs -> evalState (runReaderT (evalWithPortInfo inputs) evaluable) M.empty

src/Game/Board/Path.purs

@@ -41,6 +41,12 @@ import Game.Location (Location(..), directionTo, followDirection)
 import Game.Piece (chickenPiece, cornerCutPiece, crossPiece, idPiece, leftPiece, rightPiece)
 import Game.Rotation (Rotation(..), rotation)
 
+type Wire =
+  { inputDirection :: CardinalDirection
+  , outputDirection :: CardinalDirection 
+  , location :: Location
+  }
+
 data PathError
   = ObstructedByAnotherPiece Location
   | LocationsAreNotAdjacent Location Location
@@ -63,14 +69,6 @@ instance Show PathError where
 instance Semigroup PathError where
   append a _ = a
 
-
-type Wire =
-  { inputDirection :: CardinalDirection
-  , outputDirection :: CardinalDirection
-  , location :: Location
-  }
-
-
 getWireAt :: forall m. MonadState Board m => Location -> ExceptT PathError m (Maybe Wire)
 getWireAt location = do
   (maybePieceInfo :: Maybe PieceInfo) <- use (_pieces <<< at location)

src/Game/Board/PathSegment.purs

@@ -0,0 +1,106 @@
+module Game.Board.PathSegment where
+
+import Prelude
+
+import Control.Monad.Error.Class (class MonadError, throwError)
+import Data.Array as A
+import Data.List (List(..))
+import Data.List as L
+import Data.Map (Map)
+import Data.Map as M
+import Data.Maybe (Maybe(..), fromMaybe, isJust)
+import Data.Set as S
+import Data.Tuple (Tuple(..))
+import Data.Zipper (Zipper)
+import Game.Board.PieceInfo (PieceInfo)
+import Game.Capacity (Capacity(..))
+import Game.Direction (CardinalDirection, clockwiseRotation, rotateDirection)
+import Game.Direction as Direction
+import Game.Location (directionTo)
+import Game.Piece (chickenPiece, cornerCutPiece, crossPiece, mkWirePiece, reverseChickenPiece)
+import Game.Rotation (Rotation(..))
+import Halogen.Svg.Attributes (m)
+import Partial.Unsafe (unsafeCrashWith)
+
+{-
+  Assertions:
+
+-}
+data PathSegment
+  = SinglePath { from :: CardinalDirection, to :: CardinalDirection }
+  | DualPath
+    { from1 :: CardinalDirection
+    , to1 :: CardinalDirection
+    , from2 :: CardinalDirection
+    , to2 :: CardinalDirection
+    }
+
+data PathSegmentError
+  = NoOverlay PathSegment PathSegment
+  | InvalidSinglePath CardinalDirection CardinalDirection
+  | PathSegmentError
+
+singlePath :: forall m
+  .  MonadError PathSegmentError m
+  =>  CardinalDirection -> CardinalDirection -> m PathSegment
+singlePath from to =
+  if from /= to
+    then pure (SinglePath {from, to})
+    else throwError (InvalidSinglePath from to)
+
+dualPath :: forall m. MonadError PathSegmentError m
+  => { from :: CardinalDirection, to :: CardinalDirection }
+  -> { from :: CardinalDirection, to :: CardinalDirection }
+  -> m PathSegment
+dualPath s1 s2 =
+  if A.length (A.nub [s1.from, s1.to, s2.from, s2.to]) == 4
+    then pure (DualPath { from1: s1.from, to1: s1.to, from2: s2.from, to2: s2.to })
+    else throwError PathSegmentError
+
+--combineSegments :: forall m
+--  .  MonadError PathSegment m
+--  => PathSegment -> PathSegment -> m PathSegment
+--combineSegments p1 p2 = case p1, p2 of
+--  SinglePath s1, SinglePath s2 -> dualPath s1 s2
+--  _, _ -> throwError (NoOverlay p1 p2)
+--
+--pathSegmentAt :: CardinalDirection -> CardinalDirection -> Zipper Location -> m PathSegment
+--pathSegmentAt initialDirection terminalDirection (Zipper ls v rs) = do
+--  let from = fromMaybe initialDirection   (L.head ls >>= directionTo v)
+--  let to   = fromMaybe terminalDirection  (L.head rs >>= directionTo v)
+--  singlePath from to
+--
+--fromPiece :: forall m. MonadError PathSegmentError m
+--  => PieceInfo -> m PathSegment
+--fromPiece {piece, rotation} = do
+--  simplification <- isSimplifiable piece
+--  case simplification of
+--    IsConstant _ ->
+--    IsConnection connections -> case M.toUnfoldable connections of
+--      [Tuple from to ]
+--      [Tuple from1 to1, Tuple from2 to2] -> dualPath from1 
+--
+--
+--{-
+--  Using the assertions of the `PathSegment` type, this function is made total via `crashWith`
+---}
+--toPiece :: PathSegment -> PieceInfo
+--toPiece (SinglePath {from, to}) =
+--  let rotation = clockwiseRotation Direction.Left from
+--  in Tuple (mkWirePiece { capacity: OneBit, outputs: S.singleton (rotateDirection to rot) }) rot
+--toPiece (DualPath {from1, to1,  from2, to2}) =
+--  let Rotation r1 = clockwiseRotation from1 to1
+--      Rotation r2 = clockwiseRotation from1 from2
+--      Rotation r3 = clockwiseRotation from1 to2
+--      rotation = clockwiseRotation Direction.Left from1
+--  in case r1, r2, r3 of
+--    1, 2, 3 -> Tuple reverseChickenPiece rotation
+--    1, 3, 2 -> Tuple cornerCutPiece      (rotation <> Rotation 1 )
+--    2, 1, 3 -> Tuple crossPiece          rotation
+--    2, 3, 1 -> Tuple crossPiece          (rotation <> Rotation 1)
+--    3, 1, 2 -> Tuple cornerCutPiece      rotation
+--    3, 2, 1 -> Tuple chickenPiece        rotation
+--    _       -> unsafeCrashWith ("couldn't create a piece")
+
+
+

src/Game/Board/PseudoPiece.purs

@@ -15,7 +15,7 @@ import Data.Maybe (Maybe(..))
 import Data.String (Pattern(..))
 import Data.String as String
 import Game.Direction as Direction
-import Game.Piece (Piece(..), PieceId(..))
+import Game.Piece (Piece(..), PieceId(..), mkPiece)
 import Game.Piece.Complexity as Complexity
 import Game.Port (Port(..), matchingPort, portType)
 import Game.Port as Port
@@ -28,7 +28,7 @@ import Partial.Unsafe (unsafeCrashWith)
   The role of the psuedo input is to provide a signal to a port adjacent to the edge of the board. This means that a pseudo-input has an output port on the right, and a psuedo-output has an input port on the right.
 -}
 psuedoPiece :: Port -> Piece
-psuedoPiece port = Piece
+psuedoPiece port = mkPiece
   { name: PieceId $ case portType port of
       Port.Input  -> "psuedo-input"
       Port.Output -> "psuedo-output"

src/Game/Piece/ArithmeticPiece.purs

@@ -11,15 +11,15 @@ import Data.Tuple (Tuple(..))
 import Game.Capacity (Capacity(..), doubleCapacity, halveCapacity, maxValue, toInt)
 import Game.Direction as Direction
 import Game.Piece.Complexity as Complexity
-import Game.Piece.Types (Piece(..), PieceId(..), shouldRipple)
+import Game.Piece.Types (Piece(..), PieceId(..), mkPiece, shouldRipple)
 import Game.Port (inputPort, outputPort)
 import Game.Signal (Signal(..))
 
 succPiece :: Piece
 succPiece = mkSuccPiece TwoBit
 
 mkSuccPiece :: Capacity -> Piece
-mkSuccPiece capacity = Piece
+mkSuccPiece capacity = mkPiece
   { name: PieceId "succ"
   , eval: \m ->
       let s = fold (M.lookup Direction.Left m)
@@ -37,7 +37,7 @@ mkSuccPiece capacity = Piece
   }
 
 mkAdder :: Capacity -> Piece
-mkAdder capacity = Piece
+mkAdder capacity = mkPiece
   { name: PieceId "adder-piece"
   , eval: \m ->
       let Signal a = fold (M.lookup Direction.Left m)
@@ -63,7 +63,7 @@ mkAdder capacity = Piece
   }
 
 mkMultiplier :: Capacity -> Piece
-mkMultiplier capacity = Piece
+mkMultiplier capacity = mkPiece
   { name: PieceId "multiplier-piece"
   , eval: \m ->
       let Signal a = fold (M.lookup Direction.Left m)

src/Game/Piece/BasicPiece.purs

@@ -18,7 +18,7 @@ import Game.Direction as Direction
 import Game.Expression (Expression(..), evaluate, ref)
 import Game.Piece.Complexity (Complexity)
 import Game.Piece.Complexity as Complexity
-import Game.Piece.Types (Piece(..), PieceId(..))
+import Game.Piece.Types (Piece(..), PieceId(..), mkPiece)
 import Game.Port (inputPort, outputPort)
 
 data BasicPort = BasicInput | BasicOutput Expression
@@ -31,7 +31,7 @@ type BasicPiece =
   }
 
 basicPiece :: BasicPiece -> Piece
-basicPiece basic = Piece
+basicPiece basic = mkPiece
   { name: basic.name
   , eval: \inputs -> flip M.mapMaybe basic.ports $ case _ of
       BasicInput  -> Nothing
@@ -44,7 +44,6 @@ basicPiece basic = Piece
   , ports: basic.ports <#> case _ of
       BasicInput -> inputPort basic.capacity
       BasicOutput _ -> outputPort basic.capacity
-  , updatePort: \_ _ -> Nothing
   }
 
 
@@ -105,6 +104,13 @@ crossPiece = basicPiece
     ]
   }
 
+{-
+  There are only 6 possible dual input/dual output pieces:
+  
+
+-}
+
+
 cornerCutPiece :: Piece
 cornerCutPiece = basicPiece
   { name: PieceId "corner-cut-piece"
@@ -116,9 +122,9 @@ cornerCutPiece = basicPiece
     , Tuple Right $ BasicOutput (ref Up)
     , Tuple Down $ BasicOutput (ref Left)
     ]
-
   }
 
+
 chickenPiece :: Piece
 chickenPiece = basicPiece
   { name: PieceId "chicken-piece"

src/Game/Piece/ComparisonPiece.purs

@@ -11,7 +11,7 @@ import Data.Ord (greaterThan, lessThan)
 import Data.Tuple (Tuple(..))
 import Game.Capacity (Capacity(..))
 import Game.Direction as Direction
-import Game.Piece (Piece(..), PieceId(..))
+import Game.Piece (Piece(..), PieceId(..), mkPiece)
 import Game.Piece as Complexity
 import Game.Port (inputPort, outputPort)
 import Game.Signal (Signal(..))
@@ -30,15 +30,14 @@ type ComparisonPiece =
   }
 
 mkComparisonPiece :: ComparisonPiece -> Piece
-mkComparisonPiece piece@{ name, comparison, capacity } = Piece
+mkComparisonPiece piece@{ name, comparison, capacity } = mkPiece
   { name
   , eval: \inputs ->
       let a = fold (M.lookup Direction.Left inputs)
           b = fold (M.lookup Direction.Up inputs)
       in M.singleton Direction.Right (Signal (if comparison a b then 1 else 0))
   , complexity: Complexity.space 0.0
 
-  , shouldRipple: false
   , updateCapacity: \dir capacity' -> do
       guard (dir `elem` [Direction.Left, Direction.Up])
       pure $ mkComparisonPiece (piece {capacity = capacity'})
@@ -48,7 +47,6 @@ mkComparisonPiece piece@{ name, comparison, capacity } = Piece
       , Tuple Direction.Right (outputPort OneBit)
       , Tuple Direction.Left (inputPort capacity)
       ]
-  , updatePort: \_ _ -> Nothing
   }
 
 mkEqualPiece :: Capacity -> Piece

src/Game/Piece/FusePiece.purs

@@ -12,7 +12,7 @@ import Data.Tuple (Tuple(..))
 import Game.Capacity (Capacity(..), doubleCapacity, halveCapacity, toInt)
 import Game.Direction as Direction
 import Game.Piece.Complexity as Complexity
-import Game.Piece.Types (Piece(..), PieceId(..))
+import Game.Piece.Types (Piece(..), PieceId(..), mkPiece)
 import Game.Port (inputPort, outputPort)
 import Game.Signal (Signal(..))
 
@@ -29,15 +29,13 @@ severPiece = mkSeverPiece { outputCapacity: OneBit }
 type FusePiece = { inputCapacity :: Capacity }
 
 mkFusePiece :: FusePiece -> Piece
-mkFusePiece { inputCapacity } = Piece
+mkFusePiece { inputCapacity } = mkPiece
   { name: PieceId "fuse-piece"
   , eval: \inputs -> 
       let high = fold (M.lookup Direction.Up inputs)
           low  = fold (M.lookup Direction.Down inputs)
       in M.singleton Direction.Right (fuseSignals inputCapacity high low)
-  , complexity: Complexity.space 1.0
 
-  , shouldRipple: false
   , updateCapacity: \dir capacity -> case dir of
       Direction.Left -> Nothing
       Direction.Right -> do
@@ -56,7 +54,6 @@ mkFusePiece { inputCapacity } = Piece
         , Tuple Direction.Down  (inputPort inputCapacity)
         , Tuple Direction.Right (outputPort outputCapacity)
         ]
-  , updatePort: \_ _ -> Nothing
   }
 
 fuseSignals :: Capacity -> Signal -> Signal -> Signal
@@ -68,17 +65,15 @@ fuseSignals inputCapacity (Signal high) (Signal low) = Signal (shl high n `or` (
 type SeverPiece = { outputCapacity :: Capacity }
 
 mkSeverPiece :: SeverPiece -> Piece
-mkSeverPiece { outputCapacity } = Piece
+mkSeverPiece { outputCapacity } = mkPiece
   { name: PieceId "sever-piece"
   , eval: \inputs ->
       let Tuple high low = foldMap (severSignal outputCapacity) (M.lookup Direction.Left inputs)
       in M.fromFoldable
         [ Tuple Direction.Up high
         , Tuple Direction.Down low
         ]
-  , complexity: Complexity.space 1.0
 
-  , shouldRipple: false
   , updateCapacity: \dir capacity -> case dir of
       Direction.Right -> Nothing
       Direction.Left -> do
@@ -96,7 +91,6 @@ mkSeverPiece { outputCapacity } = Piece
         , Tuple Direction.Up    (outputPort outputCapacity)
         , Tuple Direction.Down  (outputPort outputCapacity)
         ]
-  , updatePort: \_ _ -> Nothing
   }
 
 severSignal :: Capacity -> Signal -> Tuple Signal Signal

src/Game/Piece/TwoBitSuite.purs

@@ -9,25 +9,19 @@ import Data.Tuple (Tuple(..))
 import Game.Capacity (Capacity(..))
 import Game.Direction as Direction
 import Game.Piece.Complexity as Complexity
-import Game.Piece.Types (Piece(..), PieceId(..))
+import Game.Piece.Types (Piece(..), PieceId(..), mkPiece)
 import Game.Port (inputPort, outputPort)
 import Game.Signal (Signal(..), nthBit)
 
 twoBitCrossOver :: Piece
-twoBitCrossOver = Piece
+twoBitCrossOver = mkPiece
   { name: PieceId "two-bit-cross-over"
   , eval: \m -> 
       let s = fold (M.lookup Direction.Left m)
           output = Signal $ (if nthBit s 0 then 2 else 0) + (if nthBit s 1 then 1 else 0)
       in M.singleton Direction.Right output
-  , complexity: Complexity.space 20.0
-
-  , shouldRipple: false
-  , updateCapacity: \_ _ -> Nothing
-
   , ports: M.fromFoldable
     [ Tuple Direction.Left (inputPort TwoBit)
     , Tuple Direction.Right (outputPort TwoBit)
     ]
-  , updatePort: \_ _ -> Nothing
   }