diff --git a/layout-lens/src/Data/CommonConfig.purs b/layout-lens/src/Data/CommonConfig.purs new file mode 100644 index 0000000..2ebc25d --- /dev/null +++ b/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 + diff --git a/layout-lens/src/Data/Config.purs b/layout-lens/src/Data/Config.purs index f538f0a..09dbeab 100644 --- a/layout-lens/src/Data/Config.purs +++ b/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 -derive instance Generic LayerVisualPosition _ +-- {{{ Physical layouts +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 - show = genericShow +instance Debug PhysicalLayout where + debug = genericDebug -instance Hashable LayerVisualPosition where - hash Center = 0 - hash TopLeft = 1 - hash TopRight = 2 - hash BottomLeft = 3 - hash BottomRight = 4 +instance Debug LensConfig where + debug = genericDebug diff --git a/layout-lens/src/Data/Geometry.purs b/layout-lens/src/Data/Geometry.purs new file mode 100644 index 0000000..fcabdfe --- /dev/null +++ b/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 diff --git a/layout-lens/src/Data/RawConfig.purs b/layout-lens/src/Data/RawConfig.purs index 2530a80..441752c 100644 --- a/layout-lens/src/Data/RawConfig.purs +++ b/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.Vec2 (Vec2, Radians) +import LayoutLens.Data.CommonConfig (Action, ConfigSection) +import LayoutLens.Data.Vec2 (RawScalePreservingTransform, Vec2) data RawPhysicalActionStep - = Place - { offset :: Vec2 - , rotateBy :: Radians - , rotateAround :: Vec2 - } + = Place RawScalePreservingTransform | Point - { position :: Vec2 - , size :: Vec2 - , rotateBy :: Radians - , rotateAround :: Vec2 + { size :: Vec2 + , transform :: RawScalePreservingTransform } 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 - , sections :: Array RawSection + , actions :: HashMap String Action + , 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 diff --git a/layout-lens/src/Data/Svg.purs b/layout-lens/src/Data/Svg.purs new file mode 100644 index 0000000..3983035 --- /dev/null +++ b/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 + , "" + ] + +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 diff --git a/layout-lens/src/Data/Vec2.purs b/layout-lens/src/Data/Vec2.purs index 11417a5..4e543aa 100644 --- a/layout-lens/src/Data/Vec2.purs +++ b/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 diff --git a/layout-lens/src/Main.purs b/layout-lens/src/Main.purs index f0ecf62..7476093 100644 --- a/layout-lens/src/Main.purs +++ b/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 - $ prettyPrintWith - defaultPrettyPrintOptions { maxDepth = Nothing } - $ debug result + Right result -> do + logPretty $ buildConfig result diff --git a/layout-lens/src/Parser.purs b/layout-lens/src/Parser.purs index d6d794b..3c3e383 100644 --- a/layout-lens/src/Parser.purs +++ b/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.RawConfig (RawAction(..), RawActionDisplay(..), RawActionEffect(..), RawChord(..), RawConfig(..), RawElement(..), RawKeySymbol(..), RawLayer(..), RawPhysical(..), RawPhysicalActionStep(..), RawPhysicalStep(..), RawSection(..), layerName, sectionElements) -import LayoutLens.Data.Vec2 (Radians(..), Vec2(..)) +import LayoutLens.Data.CommonConfig + ( Action(..) + , 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 - rotateBy /\ rotateAround <- P.option (Radians 0.0 /\ offset) do + position <- vec2 + 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 } - [ angle ] -> pure $ Point { position, size, rotateAround, rotateBy: Radians angle } - [ sx, sy ] -> pure $ Point { position, rotateBy, rotateAround, size: Vec2 sx sy } - [ sx, sy, angle ] -> pure $ Point - { position - , 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 - } + [] -> pure $ point position rotateBy rotateAround size + [ angle ] -> pure $ point position (Radians angle) rotateAround size + [ sx, sy ] -> pure $ point position rotateBy rotateAround (Vec2 sx sy) + [ sx, sy, angle ] -> pure $ point position (Radians angle) rotateAround (Vec2 sx sy) + [ sx, sy, angle, rx, ry ] -> pure $ point position (Radians angle) (Vec2 rx ry) (Vec2 sx sy) + _ -> 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 - (\(name /\ value) -> HM.singleton name $ wrapInto @(First RawLayer) value) + pure $ LayerGroup $ coerce $ Array.foldMap + (\(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 -rawKeySymbol = RawKeySymbol <$> name - -action :: Parser NamedRawAction +action :: Parser NamedAction 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 - RawChordGroup _ -> [] + LayerGroup layers -> layerName <$> HM.values layers + ChordGroup _ -> [] # noDuplicates "Layer" pure $ RawConfig diff --git a/layout-lens/src/Prelude.purs b/layout-lens/src/Prelude.purs index 32aee76..bdcf083 100644 --- a/layout-lens/src/Prelude.purs +++ b/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"