Implement svg and geometry privitives for lens rewrite

layout-lens/src/Data/CommonConfig.purs

@@ -0,0 +1,99 @@
+module LayoutLens.Data.CommonConfig where
+
+import LayoutLens.Prelude
+
+data LayerVisualPosition = Center | TopLeft | TopRight | BottomLeft | BottomRight
+
+data ActionDisplay
+  = DisplaySymbol String
+  | DisplayLayerColor
+
+data ActionEffect
+  = LayerSwitch String
+  | StickyLayerSwitch String
+
+newtype Action = Action
+  { display :: ActionDisplay
+  , effect :: ActionEffect
+  }
+
+newtype Chord = Chord
+  { from :: Array String
+  , to :: Array String
+  , fill :: Color
+  , fontSizeModifier :: Number
+  }
+
+newtype Layer = Layer
+  { name :: String
+  , textColor :: Maybe Color
+  , keys :: Array String
+  }
+
+data ConfigElement
+  = LayerGroup (HashMap LayerVisualPosition Layer)
+  | ChordGroup (Array Chord)
+
+newtype ConfigSection = ConfigSection
+  { columns :: Int
+  , elements :: Array ConfigElement
+  }
+
+layerName :: Layer -> String
+layerName (Layer { name }) = name
+
+sectionElements :: ConfigSection -> Array ConfigElement
+sectionElements (ConfigSection { elements }) = elements
+
+derive instance Eq LayerVisualPosition
+derive instance Eq ActionDisplay
+derive instance Eq ActionEffect
+derive instance Eq Action
+derive instance Eq Chord
+derive instance Eq Layer
+derive instance Eq ConfigElement
+derive instance Eq ConfigSection
+
+derive instance Generic LayerVisualPosition _
+derive instance Generic ActionDisplay _
+derive instance Generic ActionEffect _
+derive instance Generic Action _
+derive instance Generic Chord _
+derive instance Generic Layer _
+derive instance Generic ConfigElement _
+derive instance Generic ConfigSection _
+
+instance Debug LayerVisualPosition where
+  debug = genericDebug
+
+instance Debug ActionDisplay where
+  debug = genericDebug
+
+instance Debug ActionEffect where
+  debug = genericDebug
+
+instance Debug Action where
+  debug = genericDebug
+
+instance Debug Chord where
+  debug = genericDebug
+
+instance Debug Layer where
+  debug = genericDebug
+
+instance Debug ConfigElement where
+  debug = genericDebug
+
+instance Debug ConfigSection where
+  debug = genericDebug
+
+instance Show LayerVisualPosition where
+  show = genericShow
+
+instance Hashable LayerVisualPosition where
+  hash Center = 0
+  hash TopLeft = 1
+  hash TopRight = 2
+  hash BottomLeft = 3
+  hash BottomRight = 4
+

layout-lens/src/Data/Config.purs

@@ -1,21 +1,95 @@
-module LayoutLens.Data.Config where
+module LayoutLens.Data.Config
+  ( PhysicalKey(..)
+  , PhysicalLayout(..)
+  , LensConfig(..)
+  , buildConfig
+  , buildPhysical
+  ) where
 
 import LayoutLens.Prelude
 
-data LayerVisualPosition = Center | TopLeft | TopRight | BottomLeft | BottomRight
+import Data.Array as Array
+import LayoutLens.Data.CommonConfig (Action, ConfigSection)
+import LayoutLens.Data.RawConfig
+  ( RawConfig(..)
+  , RawPhysical(..)
+  , RawPhysicalActionStep(..)
+  , RawPhysicalStep(..)
+  )
+import LayoutLens.Data.Vec2
+  ( ScalePreservingTransform
+  , Vec2
+  , composeScalePreservingTransforms
+  , normalizeScalePreservingTransform
+  )
 
-derive instance Eq LayerVisualPosition
+-- {{{ Physical layouts
-derive instance Generic LayerVisualPosition _
+newtype PhysicalKey = PhysicalKey
+  { transform :: ScalePreservingTransform
+  , size :: Vec2
+  }
 
-instance Debug LayerVisualPosition where
+newtype PhysicalLayout = PhysicalLayout (Array PhysicalKey)
+
+type PhysicalExecutionStep = { block :: Array PhysicalKey, keys :: Array PhysicalKey }
+
+transformKey :: ScalePreservingTransform -> PhysicalKey -> PhysicalKey
+transformKey transform (PhysicalKey key) = PhysicalKey
+  { size: key.size
+  , transform: composeScalePreservingTransforms key.transform transform
+  }
+
+buildPhysical :: RawPhysical -> PhysicalLayout
+buildPhysical (RawPhysical steps) = PhysicalLayout $ _.keys =<< final
+  where
+  final :: Array PhysicalExecutionStep
+  final = Array.scanl (loop <<< _.block) initial steps
+
+  initial :: PhysicalExecutionStep
+  initial = { block: [], keys: [] }
+
+  execStep :: Array PhysicalKey -> RawPhysicalActionStep -> Array PhysicalKey
+  execStep block = case _ of
+    Point { size, transform } -> pure $ PhysicalKey
+      { size
+      , transform: normalizeScalePreservingTransform transform
+      }
+    Place transform -> block <#> transformKey (normalizeScalePreservingTransform transform)
+
+  loop :: Array PhysicalKey -> RawPhysicalStep -> PhysicalExecutionStep
+  loop block = case _ of
+    Block actions -> { block: actions >>= execStep block, keys: [] }
+    PhysicalAction action -> { block, keys: execStep block action }
+
+-- }}}
+-- {{{ Config
+newtype LensConfig = LensConfig
+  { physical :: PhysicalLayout
+  , actions :: HashMap String Action
+  , sections :: Array ConfigSection
+  }
+
+buildConfig :: RawConfig -> LensConfig
+buildConfig (RawConfig config) = LensConfig
+  { physical: buildPhysical config.physical
+  , actions: config.actions
+  , sections: config.sections
+  }
+
+-- }}}
+
+derive instance Eq PhysicalKey
+derive instance Eq PhysicalLayout
+derive instance Eq LensConfig
+derive instance Generic PhysicalKey _
+derive instance Generic PhysicalLayout _
+derive instance Generic LensConfig _
+
+instance Debug PhysicalKey where
   debug = genericDebug
 
-instance Show LayerVisualPosition where
+instance Debug PhysicalLayout where
-  show = genericShow
+  debug = genericDebug
 
-instance Hashable LayerVisualPosition where
+instance Debug LensConfig where
-  hash Center = 0
+  debug = genericDebug
-  hash TopLeft = 1
-  hash TopRight = 2
-  hash BottomLeft = 3
-  hash BottomRight = 4

layout-lens/src/Data/Geometry.purs

@@ -0,0 +1,79 @@
+module LayoutLens.Data.Geometry where
+
+import LayoutLens.Prelude
+
+import Data.Array as Array
+import LayoutLens.Data.Vec2
+  ( AABB(..)
+  , Polygon(..)
+  , ScalePreservingTransform
+  , Vec2(..)
+  , aabbToPolygon
+  , applyScalePreservingTransform
+  , mapPoints
+  , vinv
+  , vscale
+  )
+
+data Attribute = Fill Color | Stroke Color
+type Attributes = Array Attribute
+type GenericAttributes = Array (String /\ String)
+
+type Arc =
+  { radius :: Number
+  , to :: Vec2
+  }
+
+data PathStep
+  = MoveTo Vec2
+  | LineTo Vec2
+  | Arc Arc
+  | Close
+
+data Geometry
+  = Transform ScalePreservingTransform Geometry
+  | Many (Array Geometry)
+  | Text GenericAttributes Attributes String
+  | Rect AABB Attributes
+  | Path (Array PathStep) Attributes
+
+-- Approximate the size of some geometry by fitting a polygon around it
+boundingPolygon :: Geometry -> Polygon
+boundingPolygon = case _ of
+  Rect aabb _ -> aabbToPolygon aabb
+  Text _ _ _ -> mempty
+  Many array -> foldMap boundingPolygon array
+  Transform t g -> mapPoints (applyScalePreservingTransform t) $ boundingPolygon g
+  Path steps _ -> foldMap snd $ Array.scanl (points <<< fst) mempty steps
+    where
+    points :: Vec2 -> PathStep -> Vec2 /\ Polygon
+    points prev = case _ of
+      Close -> prev /\ Polygon []
+      MoveTo a -> a /\ Polygon [ a ]
+      LineTo a -> a /\ Polygon [ a ]
+      -- This is just an approximation where we fit an AABB around the circle.
+      Arc arc -> arc.to /\ aabbToPolygon aabb
+        where
+        aabb = AABB
+          { position: center <> vinv diagonal
+          , size: vscale 2.0 diagonal
+          }
+
+        diagonal = Vec2 arc.radius arc.radius
+        center = vscale 0.5 $ arc.to <> prev
+
+derive instance Eq Attribute
+derive instance Eq PathStep
+derive instance Eq Geometry
+derive instance Generic Attribute _
+derive instance Generic PathStep _
+derive instance Generic Geometry _
+
+instance Debug Attribute where
+  debug = genericDebug
+
+instance Debug PathStep where
+  debug = genericDebug
+
+instance Debug Geometry where
+  debug a = genericDebug a

layout-lens/src/Data/RawConfig.purs

@@ -2,20 +2,14 @@ module LayoutLens.Data.RawConfig where
 
 import LayoutLens.Prelude
 
-import LayoutLens.Data.Config (LayerVisualPosition)
+import LayoutLens.Data.CommonConfig (Action, ConfigSection)
-import LayoutLens.Data.Vec2 (Vec2, Radians)
+import LayoutLens.Data.Vec2 (RawScalePreservingTransform, Vec2)
 
 data RawPhysicalActionStep
-  = Place
+  = Place RawScalePreservingTransform
-      { offset :: Vec2
-      , rotateBy :: Radians
-      , rotateAround :: Vec2
-      }
   | Point
-      { position :: Vec2
+      { size :: Vec2
-      , size :: Vec2
+      , transform :: RawScalePreservingTransform
-      , rotateBy :: Radians
-      , rotateAround :: Vec2
       }
 
 data RawPhysicalStep
@@ -23,79 +17,21 @@ data RawPhysicalStep
   | PhysicalAction RawPhysicalActionStep
 
 newtype RawPhysical = RawPhysical (Array RawPhysicalStep)
-newtype RawKeySymbol = RawKeySymbol String
-
-newtype RawChord = RawChord
-  { from :: Array RawKeySymbol
-  , to :: Array RawKeySymbol
-  , fill :: Color
-  , fontSizeModifier :: Number
-  }
-
-newtype RawLayer = RawLayer
-  { name :: String
-  , textColor :: Maybe Color
-  , keys :: Array RawKeySymbol
-  }
-
-layerName :: RawLayer -> String
-layerName (RawLayer { name }) = name
-
-data RawElement
-  = RawLayerGroup (HashMap LayerVisualPosition RawLayer)
-  | RawChordGroup (Array RawChord)
-
-newtype RawSection = RawSection
-  { columns :: Int
-  , elements :: Array RawElement
-  }
-
-sectionElements :: RawSection -> Array RawElement
-sectionElements (RawSection { elements }) = elements
-
-data RawActionDisplay
-  = DisplaySymbol RawKeySymbol
-  | DisplayLayerColor
-
-data RawActionEffect
-  = LayerSwitch String
-  | StickyLayerSwitch String
-
-newtype RawAction = RawAction
-  { display :: RawActionDisplay
-  , effect :: RawActionEffect
-  }
 
 newtype RawConfig = RawConfig
   { physical :: RawPhysical
-  , actions :: HashMap String RawAction
+  , actions :: HashMap String Action
-  , sections :: Array RawSection
+  , sections :: Array ConfigSection
   }
 
 derive instance Eq RawPhysicalActionStep
 derive instance Eq RawPhysicalStep
 derive instance Eq RawPhysical
-derive instance Eq RawKeySymbol
-derive instance Eq RawChord
-derive instance Eq RawLayer
-derive instance Eq RawElement
-derive instance Eq RawSection
-derive instance Eq RawActionDisplay
-derive instance Eq RawActionEffect
-derive instance Eq RawAction
 derive instance Eq RawConfig
 
 derive instance Generic RawPhysicalActionStep _
 derive instance Generic RawPhysicalStep _
 derive instance Generic RawPhysical _
-derive instance Generic RawKeySymbol _
-derive instance Generic RawChord _
-derive instance Generic RawLayer _
-derive instance Generic RawElement _
-derive instance Generic RawSection _
-derive instance Generic RawActionDisplay _
-derive instance Generic RawActionEffect _
-derive instance Generic RawAction _
 derive instance Generic RawConfig _
 
 instance Debug RawPhysicalActionStep where
@@ -107,30 +43,6 @@ instance Debug RawPhysicalStep where
 instance Debug RawPhysical where
   debug = genericDebug
 
-instance Debug RawKeySymbol where
-  debug = genericDebug
-
-instance Debug RawChord where
-  debug = genericDebug
-
-instance Debug RawLayer where
-  debug = genericDebug
-
-instance Debug RawElement where
-  debug = genericDebug
-
-instance Debug RawActionDisplay where
-  debug = genericDebug
-
-instance Debug RawActionEffect where
-  debug = genericDebug
-
-instance Debug RawAction where
-  debug = genericDebug
-
-instance Debug RawSection where
-  debug = genericDebug
-
 instance Debug RawConfig where
   debug = genericDebug
 

layout-lens/src/Data/Svg.purs

@@ -0,0 +1,89 @@
+module LayoutLens.Data.Svg where
+
+import LayoutLens.Prelude
+
+import Data.Array as Array
+import Data.String (Pattern(..))
+import LayoutLens.Data.Geometry (Geometry(..), Attribute(..), Attributes, GenericAttributes, PathStep(..))
+import LayoutLens.Data.Vec2 (AABB(..), ScalePreservingTransform(..), Vec2(..), radiansToDegrees, x, y)
+
+indent :: String -> String
+indent = split (Pattern "\n") >>> map ("  " <> _) >>> unlines
+
+tag :: String -> GenericAttributes -> String -> String
+tag name attributes child = fold
+  [ "<"
+  , name
+  , " "
+  , joinWith " "
+      $ uncurry (\key value -> fold [ key, "=\"", value, "\"" ])
+      <$> attributes
+  , ">"
+  , indent child
+  , "</"
+  , name
+  , ">"
+  ]
+
+leaf :: String -> GenericAttributes -> String
+leaf name attributes = tag name attributes mempty
+
+printGeometryAttributes :: Attributes -> GenericAttributes
+printGeometryAttributes = map case _ of
+  Fill color -> "fill" /\ toHexString color
+  Stroke color -> "stroke" /\ toHexString color
+
+px :: Number -> String
+px n = show n <> "px"
+
+-- Render a geometry to svg
+renderGeometry :: Geometry -> String
+renderGeometry = case _ of
+  Many array -> unlines $ renderGeometry <$> array
+
+  Rect (AABB aabb) proper ->
+    leaf "rect"
+      $ printGeometryAttributes proper
+      <>
+        [ "x" /\ show (x aabb.position)
+        , "y" /\ show (y aabb.position)
+        , "width" /\ px (x aabb.size)
+        , "height" /\ px (y aabb.size)
+        ]
+
+  Path steps proper ->
+    leaf "path" $
+      Array.snoc
+        (printGeometryAttributes proper)
+        ("d" /\ joinWith " " (mkStep <$> steps))
+    where
+    vec2 (Vec2 x y) = show x <> " " <> show y
+    mkStep = case _ of
+      MoveTo p -> "M " <> vec2 p
+      LineTo p -> "L " <> vec2 p
+      Arc arc -> joinWith " "
+        [ "A"
+        , show arc.radius
+        , show arc.radius
+        , "0"
+        , "0"
+        , "0"
+        , vec2 arc.to
+        ]
+      Close -> "Z"
+
+  Text generic proper string ->
+    tag
+      "text"
+      (generic <> printGeometryAttributes proper)
+      string
+
+  Transform (ScalePreservingTransform transform) g ->
+    tag "g"
+      [ "transform" /\ fold
+          [ "rotate("
+          , show $ radiansToDegrees transform.rotation
+          , ")"
+          ]
+      ]
+      $ renderGeometry g

layout-lens/src/Data/Vec2.purs

@@ -3,16 +3,129 @@ module LayoutLens.Data.Vec2 where
 import LayoutLens.Prelude
 
 newtype Radians = Radians Number
-
 data Vec2 = Vec2 Number Number
 
+-- {{{ Base helpers
+rotateBy :: Radians -> Vec2 -> Vec2
+rotateBy (Radians angle) (Vec2 x y) = Vec2 (x * c - y * s) (x * s + y * c)
+  where
+  c = cos angle
+  s = sin angle
+
+vinv :: Vec2 -> Vec2
+vinv (Vec2 x y) = Vec2 (-x) (-y)
+
+vscale :: Number -> Vec2 -> Vec2
+vscale n (Vec2 x y) = Vec2 (n * x) (n * y)
+
+vsub :: Vec2 -> Vec2 -> Vec2
+vsub a b = a <> vinv b
+
+radiansToDegrees :: Radians -> Number
+radiansToDegrees (Radians r) = r * 180.0 / pi
+
+x :: Vec2 -> Number
+x (Vec2 x _) = x
+
+y :: Vec2 -> Number
+y (Vec2 _ y) = y
+
+-- }}}
+-- {{{ Shapes
+newtype AABB = AABB { position :: Vec2, size :: Vec2 }
+newtype Polygon = Polygon (Array Vec2)
+
+aabbToPolygon :: AABB -> Polygon
+aabbToPolygon (AABB aabb@{ size: Vec2 sx sy }) = Polygon
+  [ aabb.position
+  , aabb.position <> Vec2 0.0 sy
+  , aabb.position <> aabb.size
+  , aabb.position <> Vec2 sx 0.0
+  ]
+
+mapPoints :: (Vec2 -> Vec2) -> (Polygon -> Polygon)
+mapPoints f (Polygon points) = Polygon $ f <$> points
+
+aabbCenter :: AABB -> Vec2
+aabbCenter (AABB aabb) = aabb.position <> vscale 0.5 aabb.size
+
+-- }}}
+-- {{{ Transforms
+newtype RawScalePreservingTransform = RawScalePreservingTransform
+  { position :: Vec2
+  , rotateBy :: Radians
+  , rotateAround :: Vec2
+  }
+
+newtype ScalePreservingTransform = ScalePreservingTransform
+  { position :: Vec2
+  , rotation :: Radians
+  }
+
+normalizeScalePreservingTransform
+  :: RawScalePreservingTransform -> ScalePreservingTransform
+normalizeScalePreservingTransform (RawScalePreservingTransform t) = ScalePreservingTransform
+  { rotation: t.rotateBy
+  , position: t.rotateAround <> rotateBy t.rotateBy (vsub t.position t.rotateAround)
+  }
+
+composeScalePreservingTransforms
+  :: ScalePreservingTransform -> ScalePreservingTransform -> ScalePreservingTransform
+composeScalePreservingTransforms (ScalePreservingTransform first) (ScalePreservingTransform second) =
+  ScalePreservingTransform
+    { rotation: first.rotation <> second.rotation
+    , position: second.position <> rotateBy second.rotation first.position
+    }
+
+applyScalePreservingTransform :: ScalePreservingTransform -> Vec2 -> Vec2
+applyScalePreservingTransform (ScalePreservingTransform transform) v =
+  rotateBy transform.rotation v <> transform.position
+
+-- }}}
+
 derive instance Eq Vec2
 derive instance Eq Radians
+derive instance Eq AABB
+derive instance Eq Polygon
+derive instance Eq RawScalePreservingTransform
+derive instance Eq ScalePreservingTransform
 derive instance Generic Vec2 _
 derive instance Generic Radians _
+derive instance Generic AABB _
+derive instance Generic Polygon _
+derive instance Generic RawScalePreservingTransform _
+derive instance Generic ScalePreservingTransform _
 
 instance Debug Vec2 where
   debug = genericDebug
 
 instance Debug Radians where
   debug = genericDebug
+
+instance Debug AABB where
+  debug = genericDebug
+
+instance Debug Polygon where
+  debug = genericDebug
+
+instance Debug RawScalePreservingTransform where
+  debug = genericDebug
+
+instance Debug ScalePreservingTransform where
+  debug = genericDebug
+
+instance Semigroup Vec2 where
+  append (Vec2 a b) (Vec2 c d) = Vec2 (a + c) (b + d)
+
+instance Semigroup Radians where
+  append (Radians a) (Radians b) = Radians (a + b)
+
+derive newtype instance Semigroup Polygon
+
+instance Monoid Vec2 where
+  mempty = Vec2 0.0 0.0
+
+instance Monoid Radians where
+  mempty = Radians 0.0
+
+derive newtype instance Monoid Polygon

layout-lens/src/Main.purs

@@ -2,6 +2,8 @@ module Main where
 
 import LayoutLens.Prelude
 
+import LayoutLens.Data.Config (PhysicalLayout(..), buildConfig, buildPhysical)
+import LayoutLens.Data.RawConfig (RawConfig(..))
 import LayoutLens.Parser (parseConfig)
 import Node.Encoding (Encoding(..))
 import Node.FS.Aff (readTextFile)
@@ -11,7 +13,5 @@ main = launchAff_ do
   file <- readTextFile UTF8 "../keyboards/qmk/ferris-sweep/config.lens"
   case parseConfig file of
     Left err -> log err
-    Right result -> log
+    Right result -> do
-      $ prettyPrintWith
+      logPretty $ buildConfig result
-          defaultPrettyPrintOptions { maxDepth = Nothing }
-      $ debug result

layout-lens/src/Parser.purs

@@ -8,9 +8,25 @@ import Data.HashSet as HS
 import Data.Int as Int
 import Data.Number as Number
 import Data.String.CodeUnits as String
-import LayoutLens.Data.Config (LayerVisualPosition(..))
+import LayoutLens.Data.CommonConfig
-import LayoutLens.Data.RawConfig (RawAction(..), RawActionDisplay(..), RawActionEffect(..), RawChord(..), RawConfig(..), RawElement(..), RawKeySymbol(..), RawLayer(..), RawPhysical(..), RawPhysicalActionStep(..), RawPhysicalStep(..), RawSection(..), layerName, sectionElements)
+  ( Action(..)
-import LayoutLens.Data.Vec2 (Radians(..), Vec2(..))
+  , ActionDisplay(..)
+  , ActionEffect(..)
+  , Chord(..)
+  , ConfigElement(..)
+  , ConfigSection(..)
+  , Layer(..)
+  , LayerVisualPosition(..)
+  , layerName
+  , sectionElements
+  )
+import LayoutLens.Data.RawConfig
+  ( RawConfig(..)
+  , RawPhysical(..)
+  , RawPhysicalActionStep(..)
+  , RawPhysicalStep(..)
+  )
+import LayoutLens.Data.Vec2 (Radians(..), RawScalePreservingTransform(..), Vec2(..))
 import Safe.Coerce (coerce)
 import StringParser (Parser, printParserError, runParser)
 import StringParser as P
@@ -67,7 +83,26 @@ name = ows *> P.try do
     P.fail "Names cannot be keywords"
   pure result
   where
-  kws = [ "layergroup", "chordgroup" ]
+  kws =
+    [ "layergroup"
+    , "chordgroup"
+    , "columns"
+    , "section"
+    , "layer"
+    , "block"
+    , "end"
+    , "point"
+    , "place"
+    , "physical"
+    , "action"
+    ]
+
+displaySymbol :: Parser String
+displaySymbol = do
+  result <- name
+  pure
+    if result == "⚔️" then ""
+    else result
 
 color :: Parser Color
 color = do
@@ -111,12 +146,12 @@ physical = do
   place :: Parser RawPhysicalActionStep
   place = flip P.withError "failed to parse 'place' command" do
     string "place"
-    offset <- vec2
+    position <- vec2
-    rotateBy /\ rotateAround <- P.option (Radians 0.0 /\ offset) do
+    rotateBy /\ rotateAround <- P.option (Radians 0.0 /\ position) do
       angle <- radians
-      around <- P.option offset vec2
+      around <- P.option position vec2
       pure $ angle /\ around
-    pure $ Place { offset, rotateBy, rotateAround }
+    pure $ Place $ RawScalePreservingTransform { position, rotateBy, rotateAround }
 
   point :: Parser RawPhysicalActionStep
   point = do
@@ -126,25 +161,21 @@ physical = do
     let size = Vec2 1.0 1.0
     let rotateBy = Radians 0.0
     let rotateAround = position
+    let
+      point a b c d = Point
+        { transform: RawScalePreservingTransform { position: a, rotateBy: b, rotateAround: c }
+        , size: d
+        }
     case arguments of
-      [] -> pure $ Point { position, size, rotateBy, rotateAround }
+      [] -> pure $ point position rotateBy rotateAround size
-      [ angle ] -> pure $ Point { position, size, rotateAround, rotateBy: Radians angle }
+      [ angle ] -> pure $ point position (Radians angle) rotateAround size
-      [ sx, sy ] -> pure $ Point { position, rotateBy, rotateAround, size: Vec2 sx sy }
+      [ sx, sy ] -> pure $ point position rotateBy rotateAround (Vec2 sx sy)
-      [ sx, sy, angle ] -> pure $ Point
+      [ sx, sy, angle ] -> pure $ point position (Radians angle) rotateAround (Vec2 sx sy)
-        { position
+      [ sx, sy, angle, rx, ry ] -> pure $ point position (Radians angle) (Vec2 rx ry) (Vec2 sx sy)
-        , rotateAround
+
-        , size: Vec2 sx sy
-        , rotateBy: Radians angle
-        }
-      [ sx, sy, angle, rx, ry ] -> pure $ Point
-        { position
-        , size: Vec2 sx sy
-        , rotateBy: Radians angle
-        , rotateAround: Vec2 rx ry
-        }
       _ -> P.fail "Too many arguments provided to point"
 
-layer :: Parser (LayerVisualPosition /\ RawLayer)
+layer :: Parser (LayerVisualPosition /\ Layer)
 layer = do
   string "layer"
   layerName <- tok name
@@ -159,59 +190,56 @@ layer = do
   newline
   keys <- Array.fromFoldable
     <$> P.many1Till
-      (rawKeySymbol <* ws)
+      (displaySymbol <* ws)
       (string "end")
-  pure $ position /\ RawLayer { name: layerName, keys, textColor }
+  pure $ position /\ Layer { name: layerName, keys, textColor }
 
-layergroup :: Parser RawElement
+layergroup :: Parser ConfigElement
 layergroup = do
   string "layergroup" *> newline
   layers <- manyLines layer
   noDuplicates "Layer" $ (show <<< fst) <$> layers
-  pure $ RawLayerGroup $ coerce $ Array.foldMap
+  pure $ LayerGroup $ coerce $ Array.foldMap
-    (\(name /\ value) -> HM.singleton name $ wrapInto @(First RawLayer) value)
+    (\(name /\ value) -> HM.singleton name $ wrapInto @(First Layer) value)
     layers
 
-chord :: Parser RawChord
+chord :: Parser Chord
 chord = do
   from <- Array.fromFoldable <$> P.manyTill
-    (rawKeySymbol <* iws)
+    (name <* iws)
     (P.string "=>")
 
   to <- tok $ Array.fromFoldable <$> P.manyTill
-    (rawKeySymbol <* iws)
+    (displaySymbol <* iws)
     (P.lookAhead color)
 
   fill <- color
   fontSizeModifier <- P.option 1.0 $ tok number
-  pure $ RawChord { from, to, fill, fontSizeModifier }
+  pure $ Chord { from, to, fill, fontSizeModifier }
 
-chordgroup :: Parser RawElement
+chordgroup :: Parser ConfigElement
 chordgroup = do
   string "chordgroup" *> newline
-  c <- RawChordGroup <$> manyLines chord
+  c <- ChordGroup <$> manyLines chord
   pure c
 
-type NamedRawAction = String /\ RawAction
+type NamedAction = String /\ Action
 
-rawKeySymbol :: Parser RawKeySymbol
+action :: Parser NamedAction
-rawKeySymbol = RawKeySymbol <$> name
-
-action :: Parser NamedRawAction
 action = do
   string "action"
   actionName <- tok name
   display <- tok $ oneOf
     [ DisplayLayerColor <$ string "🌈"
-    , DisplaySymbol <$> rawKeySymbol
+    , DisplaySymbol <$> displaySymbol
     ]
   effect <- tok $ oneOf
     [ string "switch" *> (LayerSwitch <$> tok name)
     , string "sticky-switch" *> (StickyLayerSwitch <$> tok name)
     ]
-  pure $ actionName /\ RawAction { display, effect }
+  pure $ actionName /\ Action { display, effect }
 
-section :: Parser (Array NamedRawAction /\ RawSection)
+section :: Parser (Array NamedAction /\ ConfigSection)
 section = do
   string "section" *> newline
   actions /\ columnCounts /\ elements <- map fold $ manyLines $ oneOf
@@ -225,7 +253,7 @@ section = do
     [ single ] -> pure single
     _ -> P.fail $ "Column count defined multiple times " <> show columnCounts
 
-  pure $ actions /\ RawSection { columns, elements }
+  pure $ actions /\ ConfigSection { columns, elements }
   where
   parseColumns :: Parser Int
   parseColumns = P.string "columns" *> tok nat
@@ -244,8 +272,8 @@ config = do
     <#> snd
     >>= sectionElements
     >>= case _ of
-      RawLayerGroup layers -> layerName <$> HM.values layers
+      LayerGroup layers -> layerName <$> HM.values layers
-      RawChordGroup _ -> []
+      ChordGroup _ -> []
     # noDuplicates "Layer"
 
   pure $ RawConfig

layout-lens/src/Prelude.purs

@@ -21,8 +21,15 @@ module LayoutLens.Prelude
   , module Safe.Coerce
   , module Data.Newtype
   , module Data.Semigroup.First
+  , module Data.Number
+  , module Data.Semigroup.Generic
+  , module Data.Monoid.Generic
+  , module Data.String
+  , module Data.List
   , wrapInto
   , unimplemented
+  , logPretty
+  , unlines
   ) where
 
 import Prelude
@@ -38,9 +45,15 @@ import Data.HashMap (HashMap)
 import Data.HashSet (HashSet)
 import Data.Hashable (class Hashable)
 import Data.Maybe (Maybe(..), fromJust, fromMaybe, fromMaybe', isJust, isNothing, maybe, maybe', optional)
-import Data.Newtype (class Newtype, wrap)
+import Data.Monoid.Generic (genericMempty)
+import Data.Newtype (class Newtype, wrap, unwrap)
+import Data.Number (cos, sin, tan, pi)
+import Data.Semigroup.First (First(..))
+import Data.Semigroup.Generic (genericAppend)
 import Data.Show.Generic (genericShow)
+import Data.String (joinWith, split)
 import Data.Tuple (Tuple(..), curry, fst, snd, swap, uncurry)
+import Data.List (List(..))
 import Data.Tuple.Nested (type (/\), T10, T11, T2, T3, T4, T5, T6, T7, T8, T9, Tuple1, Tuple10, Tuple2, Tuple3, Tuple4, Tuple5, Tuple6, Tuple7, Tuple8, Tuple9, curry1, curry10, curry2, curry3, curry4, curry5, curry6, curry7, curry8, curry9, get1, get10, get2, get3, get4, get5, get6, get7, get8, get9, over1, over10, over2, over3, over4, over5, over6, over7, over8, over9, tuple1, tuple10, tuple2, tuple3, tuple4, tuple5, tuple6, tuple7, tuple8, tuple9, uncurry1, uncurry10, uncurry2, uncurry3, uncurry4, uncurry5, uncurry6, uncurry7, uncurry8, uncurry9, (/\))
 import Effect (Effect, forE, foreachE, untilE, whileE)
 import Effect.Aff (Aff, BracketConditions, Canceler(..), Error, Fiber, Milliseconds(..), ParAff, apathize, attempt, bracket, cancelWith, catchError, delay, effectCanceler, error, fiberCanceler, finally, forkAff, generalBracket, invincible, joinFiber, killFiber, launchAff, launchAff_, launchSuspendedAff, makeAff, message, never, nonCanceler, parallel, runAff, runAff_, runSuspendedAff, sequential, supervise, suspendAff, throwError, try)
@@ -49,10 +62,18 @@ import Effect.Class.Console (clear, group, groupCollapsed, groupEnd, grouped, in
 import Effect.Exception.Unsafe (unsafeThrow)
 import Prim.TypeError (class Warn, Text)
 import Safe.Coerce (class Coercible, coerce)
-import Data.Semigroup.First (First(..))
 
 unimplemented :: forall a. Warn (Text "unimplemenet") => a
 unimplemented = unsafeThrow "unimplemented"
 
 wrapInto :: forall a @t. Newtype t a => a -> t
 wrapInto = wrap
+
+logPretty :: forall m @a. Debug a => MonadEffect m => a -> m Unit
+logPretty a = log
+  $ prettyPrintWith
+      defaultPrettyPrintOptions { maxDepth = Nothing }
+  $ debug a
+
+unlines :: Array String -> String
+unlines = joinWith "\n"