diff --git a/Data/Kicad/PcbnewExpr/Parse.hs b/Data/Kicad/PcbnewExpr/Parse.hs --- a/Data/Kicad/PcbnewExpr/Parse.hs +++ b/Data/Kicad/PcbnewExpr/Parse.hs @@ -12,6 +12,7 @@ import Data.Kicad.SExpr hiding (parse) import qualified Data.Kicad.SExpr as SExpr (parse) import Data.Kicad.PcbnewExpr.PcbnewExpr +import Data.Kicad.Util (headOr) {-| Parse a 'PcbnewExpr' from a 'String'. Returns an 'String' with an error or a 'PcbnewExpr'. -} @@ -51,6 +52,7 @@ KeyRotate -> PcbnewExprAttribute <$> asXyz PcbnewModelRotate sxs KeyDescr -> PcbnewExprAttribute <$> asString PcbnewDescr sxs KeyTags -> PcbnewExprAttribute <$> asString PcbnewTags sxs + KeyPath -> PcbnewExprAttribute <$> asString PcbnewPath sxs KeyAttr -> PcbnewExprAttribute <$> asString PcbnewAttr sxs KeyTedit -> PcbnewExprAttribute <$> asString PcbnewTedit sxs KeyAngle -> PcbnewExprAttribute <$> asDouble PcbnewAngle sxs @@ -81,10 +83,13 @@ -> PcbnewExprAttribute <$> asInt PcbnewAutoplaceCost90 sxs KeyZoneConnect -> PcbnewExprAttribute <$> asInt PcbnewZoneConnect sxs + KeyRoundrectRratio + -> PcbnewExprAttribute <$> asDouble PcbnewRoundrectRratio sxs fromSExpr sx@(AtomStr s) = case s of "italic" -> Right $ PcbnewExprAttribute PcbnewItalic "hide" -> Right $ PcbnewExprAttribute PcbnewHide "locked" -> Right $ PcbnewExprAttribute PcbnewLocked + "placed" -> Right $ PcbnewExprAttribute PcbnewPlaced _ -> expecting "'italic' or 'hide' or 'locked' " sx fromSExpr x = expecting "List with a key or a string atom" x @@ -126,8 +131,8 @@ _ -> expecting "'at' expression (e.g. '(at 1.0 1.0)')" a interpretEffects [] fp_text = fp_text interpretEffects (e:efs) fp_text = case e of - (PcbnewJustify j) -> - interpretEffects efs (over fpTextJustify (j:) fp_text) + (PcbnewJustify js) -> + interpretEffects efs (over fpTextJustify (++ js) fp_text) (PcbnewFont size thickness italic) -> interpretEffects efs (fp_text @@ -261,6 +266,8 @@ -> pushToAttrs sxs a pad Right (PcbnewExprAttribute a@(PcbnewThermalGap _)) -> pushToAttrs sxs a pad + Right (PcbnewExprAttribute a@(PcbnewRoundrectRratio _)) + -> pushToAttrs sxs a pad _ -> expecting "at, size, drill, layers , margins etc. or nothing" sx pushToAttrs sxs a pad = interpretRest sxs (over padAttributes (++[a]) pad) asPcbnewPad xs = expecting' "number, type and shape" xs @@ -398,10 +405,16 @@ asPcbnewJustifyT :: [SExpr] -> Either String PcbnewAttribute -asPcbnewJustifyT [sx@(AtomStr s)] = case strToJustify s of - Just j -> Right (PcbnewJustify j) +asPcbnewJustifyT sx = case lefts js of + [] -> Right (PcbnewJustify (rights js)) + es -> Left (headOr "" es) + where js = fmap oneJustifyT sx + +oneJustifyT :: SExpr -> Either String PcbnewJustifyT +oneJustifyT sx@(AtomStr s) = case strToJustify s of + Just j -> Right j Nothing -> expecting justifyOneOf sx -asPcbnewJustifyT x = expecting' justifyOneOf x +oneJustifyT x = expecting justifyOneOf x expecting :: String -> SExpr -> Either String a diff --git a/Data/Kicad/PcbnewExpr/PcbnewExpr.hs b/Data/Kicad/PcbnewExpr/PcbnewExpr.hs --- a/Data/Kicad/PcbnewExpr/PcbnewExpr.hs +++ b/Data/Kicad/PcbnewExpr/PcbnewExpr.hs @@ -190,9 +190,11 @@ , AtomStr s , toSExpr (PcbnewAt a) , toSExpr (PcbnewLayer l) - ] ++ [AtomStr "hide" | h] ++ - [toSExpr $ PcbnewFpTextEffects ([PcbnewFont si th i] - ++ (fmap PcbnewJustify j))] + ] + ++ [AtomStr "hide" | h] + ++ [toSExpr $ PcbnewFpTextEffects $ + [PcbnewFont si th i] + ++ if j == [] then [] else [PcbnewJustify j]] toSExpr (PcbnewFpLine s e l w) = List [ AtomKey KeyFpLine , toSExpr (PcbnewStart s) @@ -202,10 +204,10 @@ ] toSExpr (PcbnewFpCircle s e l w) = List [ AtomKey KeyFpCircle - , toSExpr (PcbnewStart s) - , toSExpr (PcbnewEnd e) - , toSExpr (PcbnewLayer l) - , toSExpr (PcbnewWidth w) + , toSExpr (PcbnewCenter s) + , toSExpr (PcbnewEnd e) + , toSExpr (PcbnewLayer l) + , toSExpr (PcbnewWidth w) ] toSExpr (PcbnewFpArc s e a l w) = List [ AtomKey KeyFpArc @@ -354,12 +356,15 @@ | PcbnewTedit String | PcbnewItalic | PcbnewHide + | PcbnewPlaced | PcbnewLocked | PcbnewStart V2Double + | PcbnewCenter V2Double | PcbnewEnd V2Double | PcbnewWidth Double | PcbnewDescr String | PcbnewTags String + | PcbnewPath String | PcbnewAttr String | PcbnewLayers [PcbnewLayerT] | PcbnewDrill PcbnewDrillT @@ -381,19 +386,19 @@ | PcbnewModelScale PcbnewAttribute | PcbnewModelRotate PcbnewAttribute | PcbnewXyz PcbnewXyzT - | PcbnewCenter V2Double | PcbnewClearance Double | PcbnewSolderPasteRatio Double | PcbnewMaskMargin Double | PcbnewPasteMargin Double | PcbnewPasteMarginRatio Double + | PcbnewRoundrectRratio Double | PcbnewOffset V2Double | PcbnewAutoplaceCost90 Int | PcbnewAutoplaceCost180 Int | PcbnewZoneConnect Int | PcbnewThermalWidth Double | PcbnewThermalGap Double - | PcbnewJustify PcbnewJustifyT + | PcbnewJustify [PcbnewJustifyT] deriving (Show, Eq) @@ -442,12 +447,13 @@ toSExpr (PcbnewSolderPasteRatio d) = toSxD KeySolderPasteRatio d toSExpr (PcbnewMaskMargin d) = toSxD KeySolderMaskMargin d toSExpr (PcbnewPasteMargin d) = toSxD KeySolderPasteMargin d - toSExpr (PcbnewPasteMarginRatio d) = toSxD KeySolderPasteMarginRatio d - toSExpr (PcbnewThickness d) = toSxD KeyThickness d - toSExpr (PcbnewWidth d) = toSxD KeyWidth d - toSExpr (PcbnewAngle d) = toSxD KeyAngle d - toSExpr (PcbnewThermalWidth d) = toSxD KeyThermalWidth d - toSExpr (PcbnewThermalGap d) = toSxD KeyThermalGap d + toSExpr (PcbnewPasteMarginRatio d) = toSxD KeySolderPasteMarginRatio d + toSExpr (PcbnewRoundrectRratio d) = toSxD KeyRoundrectRratio d + toSExpr (PcbnewThickness d) = toSxD KeyThickness d + toSExpr (PcbnewWidth d) = toSxD KeyWidth d + toSExpr (PcbnewAngle d) = toSxD KeyAngle d + toSExpr (PcbnewThermalWidth d) = toSxD KeyThermalWidth d + toSExpr (PcbnewThermalGap d) = toSxD KeyThermalGap d toSExpr (PcbnewSize xy) = toSxDD KeySize xy toSExpr (PcbnewStart xy) = toSxDD KeyStart xy toSExpr (PcbnewCenter xy) = toSxDD KeyCenter xy @@ -458,14 +464,16 @@ toSExpr (PcbnewTedit s) = toSxStr KeyTedit s toSExpr (PcbnewDescr s) = toSxStr KeyDescr s toSExpr (PcbnewTags s) = toSxStr KeyTags s + toSExpr (PcbnewPath s) = toSxStr KeyPath s toSExpr (PcbnewAttr s) = toSxStr KeyAttr s toSExpr PcbnewItalic = AtomStr "italic" toSExpr PcbnewHide = AtomStr "hide" + toSExpr PcbnewPlaced = AtomStr "placed" toSExpr PcbnewLocked = AtomStr "locked" toSExpr (PcbnewAutoplaceCost90 i) = toSxD KeyAutoplaceCost90 (fromIntegral i) toSExpr (PcbnewAutoplaceCost180 i) = toSxD KeyAutoplaceCost180 (fromIntegral i) toSExpr (PcbnewZoneConnect i) = toSxD KeyZoneConnect (fromIntegral i) - toSExpr (PcbnewJustify j) = toSxStr KeyJustify (justifyToString j) + toSExpr (PcbnewJustify js) = List $ AtomKey KeyJustify:map (AtomStr . justifyToString) js toSxD :: Keyword -> Double -> SExpr toSxD kw d = List [AtomKey kw, AtomDbl d] @@ -622,13 +630,14 @@ fpPadTypeToStr :: PcbnewPadTypeT -> String fpPadTypeToStr t = fromMaybe "" $ lookup t $ map swap strToPadTypeMap -data PcbnewPadShapeT = Circle | Oval | Rect | Trapezoid +data PcbnewPadShapeT = Circle | Oval | Rect | Trapezoid | RoundRect deriving (Show, Eq, Enum, Bounded) strToPadShapeMap :: [(String, PcbnewPadShapeT)] strToPadShapeMap = [ ("circle" , Circle) , ("oval" , Oval) , ("rect" , Rect) + , ("roundrect", RoundRect) , ("trapezoid", Trapezoid) ] diff --git a/Data/Kicad/SExpr/Parse.hs b/Data/Kicad/SExpr/Parse.hs --- a/Data/Kicad/SExpr/Parse.hs +++ b/Data/Kicad/SExpr/Parse.hs @@ -7,6 +7,7 @@ import Text.ParserCombinators.Parsec hiding (spaces, parse) import qualified Text.ParserCombinators.Parsec as Parsec (parse) import Text.ParserCombinators.Parsec.Number +import Text.Parsec.Char (endOfLine) import Control.Monad import Data.Kicad.SExpr.SExpr @@ -14,13 +15,30 @@ {-| Parse a 'String' as a 'SExpr' or return an error. -} parse :: String -> Either String SExpr -parse input = case Parsec.parse parseList "SExpr" input of +parse input = case Parsec.parse parseListOrComment "SExpr" input of Left err -> Left $ "Parse Error: " ++ show err Right val -> Right val + +parseListOrComment :: Parser SExpr +parseListOrComment = do + spaces + skipMany parseComment + s <- parseList + return s + + +parseComment :: Parser String +parseComment = do + char '#' + s <- many (noneOf "\r\n") + endOfLine + spaces + return s + + parseList :: Parser SExpr parseList = do - spaces char '(' spaces first <- parseKeyword @@ -43,6 +61,9 @@ AtomKey KeyDescr -> do s <- parseString spaces return [s] + AtomKey KeyTags -> do s <- parseString + spaces + return [s] AtomKey KeyPad -> do n <- parseString spaces1 t <- parseString @@ -61,7 +82,7 @@ parseAtom :: Parser SExpr parseAtom = try parseDouble <|> try parseString - <|> try parseList + <|> try parseListOrComment "a double, string or s-expression" parseOneKeyword :: Keyword -> Parser SExpr @@ -83,12 +104,12 @@ parseDouble :: Parser SExpr parseDouble = do negate_or_id <- sign - -- the Bool in floating3 is requireDigit which affects whether many (False) - -- or many1 (True) is used + -- the Bool in floating3 is requireDigit which affects whether many (False, + -- 0 or more) or many1 (True, 1 or more) is used x <- floating3 True lookAhead (char ')' <|> spaceChar) return $ AtomDbl $ negate_or_id x spaces1 = skipMany1 spaceChar spaces = skipMany spaceChar -spaceChar = newline <|> space +spaceChar = endOfLine <|> space diff --git a/Data/Kicad/SExpr/SExpr.hs b/Data/Kicad/SExpr/SExpr.hs --- a/Data/Kicad/SExpr/SExpr.hs +++ b/Data/Kicad/SExpr/SExpr.hs @@ -30,9 +30,11 @@ | KeySolderMaskMargin | KeySize | KeyScale + | KeyRoundrectRratio | KeyRotate | KeyRectDelta | KeyPts + | KeyPath | KeyPad | KeyOffset | KeyModule diff --git a/kicad-data.cabal b/kicad-data.cabal --- a/kicad-data.cabal +++ b/kicad-data.cabal @@ -1,5 +1,5 @@ name: kicad-data -version: 0.3.0.0 +version: 0.4.0 synopsis: Parser and writer for KiCad files. license: MIT license-file: LICENSE @@ -31,7 +31,7 @@ -- other-modules: -- other-extensions: build-depends: - base >=4.6 && <4.9 + base >=4.4 && <4.9 , parsec >=3.1 && <3.2 , parsec-numbers >= 0.1.0 && <0.2.0 , lens-family >= 1.1 && <1.2 @@ -49,7 +49,7 @@ main-is: Test.hs build-depends: - base >= 4.6 && < 4.9 + base >=4.4 && <4.9 , parsec >=3.1 && <3.2 , parsec-numbers >= 0.1.0 && <0.2.0 , lens-family >= 1.1 && <1.2