kicad-data 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+102/−23 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- Data/Kicad/PcbnewExpr/Parse.hs +45/−14
- Data/Kicad/PcbnewExpr/PcbnewExpr.hs +51/−6
- Data/Kicad/SExpr/Parse.hs +1/−0
- Data/Kicad/SExpr/SExpr.hs +2/−0
- kicad-data.cabal +3/−3
Data/Kicad/PcbnewExpr/Parse.hs view
@@ -7,6 +7,7 @@ import Data.Maybe import Control.Applicative import Lens.Family2 (over)+import Data.List (intersperse) import Data.Kicad.SExpr hiding (parse) import qualified Data.Kicad.SExpr as SExpr (parse)@@ -55,6 +56,7 @@ KeyAngle -> PcbnewExprAttribute <$> asDouble PcbnewAngle sxs KeyThickness -> PcbnewExprAttribute <$> asDouble PcbnewThickness sxs KeyWidth -> PcbnewExprAttribute <$> asDouble PcbnewWidth sxs+ KeyJustify -> PcbnewExprAttribute <$> asPcbnewJustifyT sxs KeyThermalGap -> PcbnewExprAttribute <$> asDouble PcbnewThermalGap sxs KeyThermalWidth@@ -67,6 +69,8 @@ -> PcbnewExprAttribute <$> asDouble PcbnewMaskMargin sxs KeyClearance -> PcbnewExprAttribute <$> asDouble PcbnewClearance sxs+ KeySolderPasteRatio+ -> PcbnewExprAttribute <$> asDouble PcbnewSolderPasteRatio sxs KeyFpLine -> PcbnewExprItem <$> asFp defaultPcbnewFpLine sxs KeyFpCircle@@ -120,18 +124,26 @@ Right (PcbnewExprAttribute (PcbnewAt at)) -> interpretRest xs fp_text {itemAt = at} _ -> 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)+ (PcbnewFont size thickness italic) ->+ interpretEffects efs+ (fp_text+ { itemSize = size+ , fpTextThickness = thickness+ , fpTextItalic = italic+ }+ )+ _ -> fp_text interpretRest [] fp_text = Right fp_text interpretRest (sx:sxs) fp_text = case fromSExpr sx of Left err -> Left ('\t':err) Right (PcbnewExprAttribute (PcbnewLayer layer)) -> interpretRest sxs (fp_text {itemLayer = layer})- Right (PcbnewExprAttribute (PcbnewFpTextEffects- (PcbnewFont size thickness italic))) ->- interpretRest sxs (fp_text { itemSize = size- , fpTextThickness = thickness- , fpTextItalic = italic- }- )+ Right (PcbnewExprAttribute (PcbnewFpTextEffects effects)) ->+ interpretRest sxs (interpretEffects effects fp_text) Right (PcbnewExprAttribute PcbnewHide) -> interpretRest sxs (fp_text {fpTextHide = True}) _ -> expecting "layer or effects expression or 'hide'" sx@@ -272,15 +284,20 @@ asPcbnewAt x = expecting' "two or three floats or an 'xyz' expression" x + asPcbnewEffects :: [SExpr] -> Either String PcbnewAttribute-asPcbnewEffects [e@(List _)] =- case fromSExpr e of- Left err -> Left ('\t':err)- Right (PcbnewExprAttribute font@(PcbnewFont {}))- -> Right $ PcbnewFpTextEffects font- _ -> expecting "font-expression" e-asPcbnewEffects x = expecting' "one effects-expression (e.g. font)" x+asPcbnewEffects xs = interpretRest xs []+ where+ interpretRest [] effects = Right (PcbnewFpTextEffects effects)+ interpretRest (sx:sxs) effects = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute justify@(PcbnewJustify _))+ -> interpretRest sxs (justify:effects)+ Right (PcbnewExprAttribute font@(PcbnewFont _ _ _))+ -> interpretRest sxs (font:effects)+ _ -> expecting "font or justify expression" sx + asPcbnewFont :: [SExpr] -> Either String PcbnewAttribute asPcbnewFont xs = interpretRest xs defaultPcbnewFont where@@ -372,6 +389,20 @@ interpretRest sxs model {pcbnewModelRotate = xyz} Right _ -> expecting "only at, scale and rotate" sx asPcbnewModel x = expecting' "model path, at, scale and rotate" x+++justifyOneOf :: String+justifyOneOf = "one of '"+ ++ concat (intersperse ", " (fmap justifyToString [minBound..]))+ ++ "'"+++asPcbnewJustifyT :: [SExpr] -> Either String PcbnewAttribute+asPcbnewJustifyT [sx@(AtomStr s)] = case strToJustify s of+ Just j -> Right (PcbnewJustify j)+ Nothing -> expecting justifyOneOf sx+asPcbnewJustifyT x = expecting' justifyOneOf x+ expecting :: String -> SExpr -> Either String a expecting x y =
Data/Kicad/PcbnewExpr/PcbnewExpr.hs view
@@ -14,9 +14,11 @@ , PcbnewPadShapeT(..) , PcbnewPadTypeT(..) , PcbnewFpTextTypeT(..)+, PcbnewJustifyT(..) , PcbnewXyzT , V2Double -- * Lenses and other getters/setters+, fpTextJustify , moduleItems , moduleAttrs , itemLayers@@ -36,6 +38,8 @@ , fpPadShapeToStr , strToFpTextType , fpTextTypeToStr+, strToJustify+, justifyToString -- * Default (empty) instances , defaultPcbnewModule , defaultPcbnewFpText@@ -114,6 +118,7 @@ , itemSize :: V2Double , fpTextThickness :: Double , fpTextItalic :: Bool+ , fpTextJustify_ :: [PcbnewJustifyT] } | PcbnewFpLine { itemStart :: V2Double , itemEnd :: V2Double@@ -179,14 +184,15 @@ instance SExpressable PcbnewItem where- toSExpr (PcbnewFpText t s a l h si th i) =+ toSExpr (PcbnewFpText t s a l h si th i j) = List $ [ AtomKey KeyFpText , AtomStr $ fpTextTypeToStr t , AtomStr s , toSExpr (PcbnewAt a) , toSExpr (PcbnewLayer l) ] ++ [AtomStr "hide" | h] ++- [toSExpr $ PcbnewFpTextEffects $ PcbnewFont si th i]+ [toSExpr $ PcbnewFpTextEffects ([PcbnewFont si th i]+ ++ (fmap PcbnewJustify j))] toSExpr (PcbnewFpLine s e l w) = List [ AtomKey KeyFpLine , toSExpr (PcbnewStart s)@@ -236,7 +242,8 @@ padAttributes f i = (\as -> i {padAttributes_ = as}) `fmap` f (padAttributes_ i) instance AEq PcbnewItem where- (PcbnewFpText t1 s1 a1 l1 h1 si1 th1 i1) ~== (PcbnewFpText t2 s2 a2 l2 h2 si2 th2 i2) =+ (PcbnewFpText t1 s1 a1 l1 h1 si1 th1 i1 j1)+ ~== (PcbnewFpText t2 s2 a2 l2 h2 si2 th2 i2 j2) = t1 == t2 && s1 == s2 && a1 ~== a2@@ -245,6 +252,7 @@ && si1 ~== si2 && th1 ~== th2 && i1 == i2+ && j1 == j2 (PcbnewFpLine s1 e1 l1 w1) ~== (PcbnewFpLine s2 e2 l2 w2) = s1 ~== s2 && e1 ~== e2@@ -285,6 +293,7 @@ , itemSize = (1.0, 1.0) , fpTextThickness = 1.0 , fpTextItalic = False+ , fpTextJustify_ = [] } defaultPcbnewFpLine :: PcbnewItem@@ -355,7 +364,7 @@ | PcbnewLayers [PcbnewLayerT] | PcbnewDrill PcbnewDrillT | PcbnewRectDelta V2Double- | PcbnewFpTextEffects PcbnewAttribute+ | PcbnewFpTextEffects [PcbnewAttribute] | PcbnewFont { pcbnewFontSize :: V2Double , pcbnewFontThickness :: Double , pcbnewFontItalic :: Bool@@ -374,6 +383,7 @@ | PcbnewXyz PcbnewXyzT | PcbnewCenter V2Double | PcbnewClearance Double+ | PcbnewSolderPasteRatio Double | PcbnewMaskMargin Double | PcbnewPasteMargin Double | PcbnewPasteMarginRatio Double@@ -383,8 +393,11 @@ | PcbnewZoneConnect Int | PcbnewThermalWidth Double | PcbnewThermalGap Double+ | PcbnewJustify PcbnewJustifyT deriving (Show, Eq) ++ type PcbnewXyzT = (Double, Double, Double) instance SExpressable PcbnewAttribute where@@ -420,12 +433,13 @@ ++ [toSExpr (PcbnewOffset (fromJust off)) | isJust off] toSExpr (PcbnewXyz (x,y,z)) = List [AtomKey KeyXyz, AtomDbl x, AtomDbl y, AtomDbl z]- toSExpr (PcbnewFpTextEffects a) = List [AtomKey KeyEffects, toSExpr a]+ toSExpr (PcbnewFpTextEffects l) = List $ [AtomKey KeyEffects] ++ fmap toSExpr l toSExpr (PcbnewFpTextType t) = AtomStr $ fpTextTypeToStr t toSExpr (PcbnewModelAt xyz) = List [AtomKey KeyAt , toSExpr xyz] toSExpr (PcbnewModelScale xyz) = List [AtomKey KeyScale , toSExpr xyz] toSExpr (PcbnewModelRotate xyz) = List [AtomKey KeyRotate, toSExpr xyz] toSExpr (PcbnewClearance d) = toSxD KeyClearance d+ toSExpr (PcbnewSolderPasteRatio d) = toSxD KeySolderPasteRatio d toSExpr (PcbnewMaskMargin d) = toSxD KeySolderMaskMargin d toSExpr (PcbnewPasteMargin d) = toSxD KeySolderPasteMargin d toSExpr (PcbnewPasteMarginRatio d) = toSxD KeySolderPasteMarginRatio d@@ -451,6 +465,7 @@ 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) toSxD :: Keyword -> Double -> SExpr toSxD kw d = List [AtomKey kw, AtomDbl d]@@ -508,7 +523,7 @@ | BCu | BPaste | BMask | DwgsUser | CmtsUser | FAdhes | AllSilk | FandBCu | AllCu | AllMask | AllPaste | EdgeCuts | FCrtYd | BCrtYd | FFab- | BFab+ | BFab | Margin | Eco1User | Eco2User | BAdhes | Inner1Cu | Inner2Cu | Inner3Cu | Inner4Cu | Inner5Cu | Inner6Cu | Inner7Cu | Inner8Cu | Inner9Cu | Inner10Cu | Inner11Cu | Inner12Cu | Inner13Cu | Inner14Cu | Inner15Cu@@ -531,6 +546,7 @@ , ("Dwgs.User" , DwgsUser) , ("Cmts.User" , CmtsUser) , ("F.Adhes" , FAdhes)+ , ("B.Adhes" , BAdhes) , ("F&B.Cu" , FandBCu) , ("*.Cu" , AllCu ) , ("*.Mask" , AllMask)@@ -541,6 +557,9 @@ , ("F.Fab" , FFab) , ("B.Fab" , BFab) , ("Edge.Cuts" , EdgeCuts)+ , ("Margin" , Margin)+ , ("Eco1.User" , Eco1User)+ , ("Eco2.User" , Eco2User) , ("Inner1.Cu" , Inner1Cu) , ("Inner2.Cu" , Inner2Cu) , ("Inner3.Cu" , Inner3Cu)@@ -619,6 +638,26 @@ fpPadShapeToStr :: PcbnewPadShapeT -> String fpPadShapeToStr t = fromMaybe "" $ lookup t $ map swap strToPadShapeMap +data PcbnewJustifyT =+ JustifyLeft | JustifyRight | JustifyTop | JustifyBottom | JustifyMirror+ deriving (Show, Eq, Enum, Bounded)+++strToJustifyMap :: [(String, PcbnewJustifyT)]+strToJustifyMap =+ [ ("left" , JustifyLeft)+ , ("right" , JustifyRight)+ , ("top" , JustifyTop)+ , ("bottom", JustifyBottom)+ , ("mirror", JustifyMirror)+ ]++strToJustify :: String -> Maybe PcbnewJustifyT+strToJustify s = lookup s strToJustifyMap++justifyToString :: PcbnewJustifyT -> String+justifyToString t = fromMaybe "" $ lookup t $ map swap strToJustifyMap+ data PcbnewAtT = PcbnewAtT { pcbnewAtPoint :: V2Double , pcbnewAtOrientation :: Double }@@ -631,6 +670,12 @@ defaultPcbnewAtT = PcbnewAtT { pcbnewAtPoint = (0,0) , pcbnewAtOrientation = 0 }++fpTextJustify :: Functor f => LensLike' f PcbnewItem [PcbnewJustifyT]+fpTextJustify f (PcbnewFpText t s a l h si th i j) =+ (\j' -> PcbnewFpText t s a l h si th i j') `fmap` f j+fpTextJustify f x = (\_ -> x) `fmap` f []+ atP :: Functor f => LensLike' f PcbnewAtT V2Double atP f (PcbnewAtT p o) = (\p' -> PcbnewAtT p' o) `fmap` f p
Data/Kicad/SExpr/Parse.hs view
@@ -20,6 +20,7 @@ parseList :: Parser SExpr parseList = do+ spaces char '(' spaces first <- parseKeyword
Data/Kicad/SExpr/SExpr.hs view
@@ -39,6 +39,7 @@ | KeyModel | KeyLayers | KeyLayer+ | KeyJustify | KeyFpText | KeyFpPoly | KeyFpLine@@ -50,6 +51,7 @@ | KeyDrill | KeyDescr | KeyClearance+ | KeySolderPasteRatio | KeyCenter | KeyAutoplaceCost90 | KeyAutoplaceCost180
kicad-data.cabal view
@@ -1,5 +1,5 @@ name: kicad-data-version: 0.2.0.0+version: 0.3.0.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.8+ base >=4.6 && <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 && < 5+ base >= 4.6 && < 4.9 , parsec >=3.1 && <3.2 , parsec-numbers >= 0.1.0 && <0.2.0 , lens-family >= 1.1 && <1.2