kicad-data (empty) → 0.1.0.0
raw patch · 12 files changed
+1346/−0 lines, 12 filesdep +QuickCheckdep +basedep +ieee754setup-changed
Dependencies added: QuickCheck, base, ieee754, kicad-data, lens-family, parsec, parsec-numbers, pretty-compact, test-framework, test-framework-quickcheck2
Files
- Data/Kicad/PcbnewExpr.hs +15/−0
- Data/Kicad/PcbnewExpr/Parse.hs +389/−0
- Data/Kicad/PcbnewExpr/PcbnewExpr.hs +612/−0
- Data/Kicad/PcbnewExpr/Write.hs +19/−0
- Data/Kicad/SExpr.hs +19/−0
- Data/Kicad/SExpr/Parse.hs +93/−0
- Data/Kicad/SExpr/SExpr.hs +62/−0
- Data/Kicad/SExpr/Write.hs +45/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- kicad-data.cabal +61/−0
- tests/Test.hs +9/−0
+ Data/Kicad/PcbnewExpr.hs view
@@ -0,0 +1,15 @@+module Data.Kicad.PcbnewExpr+(+-- * Types+ PcbnewExpr(..)+-- * Parse+, parse+, fromSExpr+-- * Write+, pretty+, write+)+where+import Data.Kicad.PcbnewExpr.PcbnewExpr+import Data.Kicad.PcbnewExpr.Parse+import Data.Kicad.PcbnewExpr.Write
+ Data/Kicad/PcbnewExpr/Parse.hs view
@@ -0,0 +1,389 @@+module Data.Kicad.PcbnewExpr.Parse+( parse+, fromSExpr+)+where+import Data.Either+import Data.Maybe+import Control.Applicative+import Lens.Family2 (over)++import Data.Kicad.SExpr hiding (parse)+import qualified Data.Kicad.SExpr as SExpr (parse)+import Data.Kicad.PcbnewExpr.PcbnewExpr++{-| Parse a 'PcbnewExpr' from a 'String'. Returns an 'String' with an error or+ a 'PcbnewExpr'. -}+parse :: String -> Either String PcbnewExpr+parse = either Left fromSExpr . SExpr.parse++{-| Interpret a 'SExpr' as a 'PcbnewExpr'. -}+fromSExpr :: SExpr -> Either String PcbnewExpr+fromSExpr (List (AtomKey kw:sxs)) =+ case go of+ Left err -> Left $ "Could not fromSExpr '" ++ writeKeyword kw +++ "' because:\n\t" ++ err+ Right expr -> Right expr+ where go = case kw of+ KeyModule -> PcbnewExprModule <$> asPcbnewModule sxs+ KeyPad -> PcbnewExprItem <$> asPcbnewPad sxs+ KeyFpText -> PcbnewExprItem <$> asPcbnewFpText sxs+ KeyFpArc -> PcbnewExprItem <$> asPcbnewFpArc sxs+ KeyFpPoly -> PcbnewExprItem <$> asPcbnewFpPoly sxs+ KeyLayer -> PcbnewExprAttribute <$> asPcbnewLayer sxs+ KeyAt -> PcbnewExprAttribute <$> asPcbnewAt sxs+ KeyEffects -> PcbnewExprAttribute <$> asPcbnewEffects sxs+ KeyFont -> PcbnewExprAttribute <$> asPcbnewFont sxs+ KeyLayers -> PcbnewExprAttribute <$> asPcbnewLayers sxs+ KeyPts -> PcbnewExprAttribute <$> asPcbnewPts sxs+ KeyXyz -> PcbnewExprAttribute <$> asPcbnewXyz sxs+ KeyModel -> PcbnewExprAttribute <$> asPcbnewModel sxs+ KeyDrill -> PcbnewExprAttribute <$> asPcbnewDrill sxs+ KeySize -> PcbnewExprAttribute <$> asXy PcbnewSize sxs+ KeyStart -> PcbnewExprAttribute <$> asXy PcbnewStart sxs+ KeyEnd -> PcbnewExprAttribute <$> asXy PcbnewEnd sxs+ KeyCenter -> PcbnewExprAttribute <$> asXy PcbnewCenter sxs+ KeyRectDelta -> PcbnewExprAttribute <$> asXy PcbnewRectDelta sxs+ KeyXy -> PcbnewExprAttribute <$> asXy PcbnewXy sxs+ KeyOffset -> PcbnewExprAttribute <$> asXy PcbnewOffset sxs+ KeyScale -> PcbnewExprAttribute <$> asXyz PcbnewModelScale sxs+ KeyRotate -> PcbnewExprAttribute <$> asXyz PcbnewModelRotate sxs+ KeyDescr -> PcbnewExprAttribute <$> asString PcbnewDescr sxs+ KeyTags -> PcbnewExprAttribute <$> asString PcbnewTags sxs+ KeyAttr -> PcbnewExprAttribute <$> asString PcbnewAttr sxs+ KeyTedit -> PcbnewExprAttribute <$> asString PcbnewTedit sxs+ KeyAngle -> PcbnewExprAttribute <$> asDouble PcbnewAngle sxs+ KeyThickness -> PcbnewExprAttribute <$> asDouble PcbnewThickness sxs+ KeyWidth -> PcbnewExprAttribute <$> asDouble PcbnewWidth sxs+ KeyThermalGap+ -> PcbnewExprAttribute <$> asDouble PcbnewThermalGap sxs+ KeyThermalWidth+ -> PcbnewExprAttribute <$> asDouble PcbnewThermalWidth sxs+ KeySolderPasteMarginRatio+ -> PcbnewExprAttribute <$> asDouble PcbnewPasteMarginRatio sxs+ KeySolderPasteMargin+ -> PcbnewExprAttribute <$> asDouble PcbnewPasteMargin sxs+ KeySolderMaskMargin+ -> PcbnewExprAttribute <$> asDouble PcbnewMaskMargin sxs+ KeyClearance+ -> PcbnewExprAttribute <$> asDouble PcbnewClearance sxs+ KeyFpLine+ -> PcbnewExprItem <$> asFp defaultPcbnewFpLine sxs+ KeyFpCircle+ -> PcbnewExprItem <$> asFp defaultPcbnewFpCircle sxs+ KeyAutoplaceCost180+ -> PcbnewExprAttribute <$> asInt PcbnewAutoplaceCost180 sxs+ KeyAutoplaceCost90+ -> PcbnewExprAttribute <$> asInt PcbnewAutoplaceCost90 sxs+ KeyZoneConnect+ -> PcbnewExprAttribute <$> asInt PcbnewZoneConnect sxs+fromSExpr sx@(AtomStr s) = case s of+ "italic" -> Right $ PcbnewExprAttribute PcbnewItalic+ "hide" -> Right $ PcbnewExprAttribute PcbnewHide+ "locked" -> Right $ PcbnewExprAttribute PcbnewLocked+ _ -> expecting "'italic' or 'hide' or 'locked' " sx+fromSExpr x = expecting "List with a key or a string atom" x++asPcbnewModule :: [SExpr] -> Either String PcbnewModule+asPcbnewModule (AtomStr n:xs) =+ interpretRest xs defaultPcbnewModule { pcbnewModuleName = n }+ where+ interpretRest [] m = Right m+ interpretRest (sx:sxs) m = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewLayer layer)) ->+ interpretRest sxs m {pcbnewModuleLayer = layer}+ Right (PcbnewExprItem item) ->+ interpretRest sxs (over moduleItems (++[item]) m)+ Right (PcbnewExprAttribute attr) ->+ interpretRest sxs (over moduleAttrs (++[attr]) m)+ Right _ -> expecting "layer, items or attributes" sx+asPcbnewModule (x:_) = expecting "module name" x+asPcbnewModule x = expecting' "module name" x++asPcbnewFpText :: [SExpr] -> Either String PcbnewItem+asPcbnewFpText (t:s:a:xs) = interpretType+ where+ interpretType = case t of+ (AtomStr "reference") ->+ interpretString (defaultPcbnewFpText {fpTextType = FpTextReference})+ (AtomStr "value") ->+ interpretString (defaultPcbnewFpText {fpTextType = FpTextValue})+ (AtomStr "user") ->+ interpretString (defaultPcbnewFpText {fpTextType = FpTextUser})+ _ -> expecting "'reference', 'value' or 'user'" t+ interpretString fp_text = case s of+ (AtomStr string) -> interpretAt fp_text {fpTextStr = string}+ _ -> expecting "string" s+ interpretAt fp_text = case fromSExpr a of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewAt at)) ->+ interpretRest xs fp_text {itemAt = at}+ _ -> expecting "'at' expression (e.g. '(at 1.0 1.0)')" a+ 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 PcbnewHide) ->+ interpretRest sxs (fp_text {fpTextHide = True})+ _ -> expecting "layer or effects expression or 'hide'" sx+asPcbnewFpText x = expecting' "a text-type, text, 'at' and layer" x++asFp :: PcbnewItem -> [SExpr] -> Either String PcbnewItem+asFp defaultFp (s:e:xs) = interpretStart defaultFp+ where+ interpretStart fp_shape = case fromSExpr s of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewStart start)) ->+ interpretEnd fp_shape {itemStart = start}+ Right (PcbnewExprAttribute (PcbnewCenter center)) ->+ interpretEnd fp_shape {itemStart = center}+ Right _ -> expecting "start (e.g. '(start 1.0 1.0)')" s+ interpretEnd fp_shape = case fromSExpr e of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewEnd end)) ->+ interpretRest xs fp_shape {itemEnd = end}+ Right _ -> expecting "end (e.g. '(end 1.0 1.0)')" e+ interpretRest [] fp_shape = Right fp_shape+ interpretRest (sx:sxs) fp_shape = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewWidth d))+ -> interpretRest sxs fp_shape {itemWidth = d}+ Right (PcbnewExprAttribute (PcbnewLayer d))+ -> interpretRest sxs fp_shape {itemLayer = d}+ Right _ -> expecting "width or layer" sx+asFp _ x = expecting' "fp_line (or fp_circle) start (center), end and attributes" x++asPcbnewFpArc :: [SExpr] -> Either String PcbnewItem+asPcbnewFpArc (s:e:xs) = interpretStart defaultPcbnewFpArc+ where+ interpretStart fp_arc = case fromSExpr s of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewStart start)) ->+ interpretEnd fp_arc {itemStart = start}+ Right _ -> expecting "start (e.g. '(start 1.0 1.0)')" s+ interpretEnd fp_arc = case fromSExpr e of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewEnd end)) ->+ interpretRest xs fp_arc {itemEnd = end}+ Right _ -> expecting "end (e.g. '(end 1.0 1.0)')" e+ interpretRest [] fp_arc = Right fp_arc+ interpretRest (sx:sxs) fp_arc = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewWidth d))+ -> interpretRest sxs fp_arc {itemWidth = d}+ Right (PcbnewExprAttribute (PcbnewLayer d))+ -> interpretRest sxs fp_arc {itemLayer = d}+ Right (PcbnewExprAttribute (PcbnewAngle d))+ -> interpretRest sxs fp_arc {fpArcAngle = d}+ Right _ -> expecting "width, layer or angle" sx+asPcbnewFpArc x = expecting' "fp_arc start, end and attributes" x++asPcbnewFpPoly :: [SExpr] -> Either String PcbnewItem+asPcbnewFpPoly xs = interpretRest xs defaultPcbnewFpPoly+ where+ interpretRest [] fp_poly = Right fp_poly+ interpretRest (sx:sxs) fp_poly = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewPts d))+ -> interpretRest sxs fp_poly {fpPolyPts = d}+ Right (PcbnewExprAttribute (PcbnewWidth d))+ -> interpretRest sxs fp_poly {itemWidth = d}+ Right (PcbnewExprAttribute (PcbnewLayer d))+ -> interpretRest sxs fp_poly {itemLayer = d}+ Right _ -> expecting "width, layer or 'pts'" sx++asPcbnewPad :: [SExpr] -> Either String PcbnewItem+asPcbnewPad (n:t:s:xs) = interpretNumber+ where+ interpretNumber = case n of+ (AtomStr num) -> interpretType defaultPcbnewPad {padNumber = num}+ _ -> expecting "string designating pad number" n+ interpretType :: PcbnewItem -> Either String PcbnewItem+ interpretType pad = case t of+ (AtomStr str) -> case strToPadType str of+ Just d -> interpretShape pad {padType = d}+ Nothing ->+ expecting "pad type (e.g. 'smd')" t+ _ -> expecting "pad type string (e.g. 'smd')" t+ interpretShape :: PcbnewItem -> Either String PcbnewItem+ interpretShape pad = case s of+ (AtomStr str) -> case strToPadShape str of+ Just d -> interpretRest xs pad {padShape = d}+ Nothing ->+ expecting "pad shape (e.g. 'circle')" s+ _ -> expecting "pad shape string (e.g. 'circle')" s+ interpretRest :: [SExpr] -> PcbnewItem -> Either String PcbnewItem+ interpretRest [] pad = Right pad+ interpretRest (sx:sxs) pad = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewAt d))+ -> interpretRest sxs pad {itemAt = d}+ Right (PcbnewExprAttribute (PcbnewLayers d))+ -> interpretRest sxs pad {padLayers = d}+ Right (PcbnewExprAttribute (PcbnewSize d))+ -> interpretRest sxs pad {itemSize = d}+ Right (PcbnewExprAttribute a@(PcbnewDrill _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewRectDelta _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewMaskMargin _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewPasteMarginRatio _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewPasteMargin _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewClearance _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewZoneConnect _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewThermalWidth _))+ -> pushToAttrs sxs a pad+ Right (PcbnewExprAttribute a@(PcbnewThermalGap _))+ -> 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++asPcbnewLayer :: [SExpr] -> Either String PcbnewAttribute+asPcbnewLayer [sx] = onePcbnewLayer sx+asPcbnewLayer x = expecting' "only one layer name" x++onePcbnewLayer :: SExpr -> Either String PcbnewAttribute+onePcbnewLayer (AtomStr n) = case strToLayer n of+ Just l -> Right $ PcbnewLayer l+ Nothing -> Left ("-> Unknown layer name: " ++ n)+onePcbnewLayer x = expecting "layer name" x++asPcbnewAt :: [SExpr] -> Either String PcbnewAttribute+asPcbnewAt (AtomDbl x:[AtomDbl y]) =+ Right $ PcbnewAt $ defaultPcbnewAtT {pcbnewAtPoint = (x,y)}+asPcbnewAt (AtomDbl x:AtomDbl y:[AtomDbl o]) =+ Right $ PcbnewAt $ PcbnewAtT (x,y) o+asPcbnewAt l@[List _] = asXyz PcbnewModelAt l+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++asPcbnewFont :: [SExpr] -> Either String PcbnewAttribute+asPcbnewFont xs = interpretRest xs defaultPcbnewFont+ where+ interpretRest [] font = Right font+ interpretRest (sx:sxs) font = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewSize size)) ->+ interpretRest sxs font {pcbnewFontSize = size}+ Right (PcbnewExprAttribute (PcbnewThickness t)) ->+ interpretRest sxs font {pcbnewFontThickness = t}+ Right (PcbnewExprAttribute PcbnewItalic) ->+ interpretRest sxs font {pcbnewFontItalic = True}+ Right _ -> expecting "size, thickness or 'italic'" sx++asXy :: ((Double, Double) -> a) -> [SExpr] -> Either String a+asXy constructor [AtomDbl x, AtomDbl y] = Right $ constructor (x,y)+asXy _ x = expecting' "two floats (e.g. 1.0 1.0)" x++asPcbnewPts :: [SExpr] -> Either String PcbnewAttribute+asPcbnewPts = fmap PcbnewPts . foldr interpretXys (Right [])+ where interpretXys sx z = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewXy xy))+ -> Right (xy:) <*> z+ Right _ -> expecting "'xy' (e.g. '(xy 1.0 1.0)')" sx++asString :: (String -> PcbnewAttribute) -> [SExpr] -> Either String PcbnewAttribute+asString pcbnew [AtomStr s] = Right $ pcbnew s+asString _ x = expecting' "string" x++asPcbnewLayers :: [SExpr] -> Either String PcbnewAttribute+asPcbnewLayers [] = Right $ PcbnewLayers []+asPcbnewLayers xs = let layers = map onePcbnewLayer xs in case lefts layers of+ [] -> Right $ PcbnewLayers $ map (\(PcbnewLayer l) -> l) $ rights layers+ _ -> Left $ "Could not fromSExpr layers:\n"+ ++ unlines (map ("\t\t"++) (lefts layers))++asDouble :: (Double -> PcbnewAttribute) -> [SExpr] -> Either String PcbnewAttribute+asDouble constructor [AtomDbl d] = Right $ constructor d+asDouble _ x = expecting' "one float (e.g. '1.0')" x++asInt :: (Int -> PcbnewAttribute) -> [SExpr] -> Either String PcbnewAttribute+asInt constructor [AtomDbl d] = Right $ constructor $ round d+asInt _ x = expecting' "one int (e.g. '1')" x++asPcbnewDrill :: [SExpr] -> Either String PcbnewAttribute+asPcbnewDrill xs = interpretRest xs defaultPcbnewDrillT+ where+ interpretRest [] drill = Right $ PcbnewDrill drill+ interpretRest (sx:sxs) drill = case sx of+ AtomDbl d -> if isNothing (pcbnewDrillSize drill)+ then interpretRest sxs drill+ { pcbnewDrillSize = Just (d,d) }+ else interpretRest sxs drill+ { pcbnewDrillSize =+ fmap (\(x,_) -> (x,d)) (pcbnewDrillSize drill)+ }+ AtomStr "oval" -> interpretRest sxs drill {pcbnewDrillOval = True}+ (List _) -> case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewOffset xy))+ -> interpretRest sxs drill {pcbnewDrillOffset = Just xy}+ Right _ -> expecting "offset or nothing" sx+ _ -> expecting "float, 'oval' or offset" sx++asPcbnewXyz :: [SExpr] -> Either String PcbnewAttribute+asPcbnewXyz (AtomDbl x:AtomDbl y:[AtomDbl z]) =+ Right $ PcbnewXyz (x,y,z)+asPcbnewXyz x = expecting' "three floats" x++asXyz :: (PcbnewAttribute -> a) -> [SExpr] -> Either String a+asXyz constructor [l@(List _)] = case fromSExpr l of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute xyz) -> Right $ constructor xyz+ Right _ -> expecting "xyz (e.g. '(xyz 1 1 1)')" l+asXyz _ x = expecting' "xyz (e.g. '(xyz 1 1 1)')" x++asPcbnewModel :: [SExpr] -> Either String PcbnewAttribute+asPcbnewModel (AtomStr p:xs) = interpretRest xs defaultPcbnewModel {pcbnewModelPath = p}+ where+ interpretRest [] model = Right model+ interpretRest (sx:sxs) model = case fromSExpr sx of+ Left err -> Left ('\t':err)+ Right (PcbnewExprAttribute (PcbnewModelAt (PcbnewXyz xyz))) ->+ interpretRest sxs model {pcbnewModelAt = xyz}+ Right (PcbnewExprAttribute (PcbnewModelScale (PcbnewXyz xyz))) ->+ interpretRest sxs model {pcbnewModelScale = xyz}+ Right (PcbnewExprAttribute (PcbnewModelRotate (PcbnewXyz xyz))) ->+ interpretRest sxs model {pcbnewModelRotate = xyz}+ Right _ -> expecting "only at, scale and rotate" sx+asPcbnewModel x = expecting' "model path, at, scale and rotate" x++expecting :: String -> SExpr -> Either String a+expecting x y =+ Left $ "-> Expecting " ++ x ++ " but got " +++ nothing_or (strip_brackets (write y)) ++ " instead"+ where+ nothing_or y' = case y' of+ "" -> "nothing"+ _ -> "'" ++ y' ++ "'"+ strip_brackets y' = case head y' of+ '(' -> tail . init $ y'+ _ -> y'++expecting' :: String -> [SExpr] -> Either String a+expecting' x y = expecting x $ List y
+ Data/Kicad/PcbnewExpr/PcbnewExpr.hs view
@@ -0,0 +1,612 @@+module Data.Kicad.PcbnewExpr.PcbnewExpr+(+-- * Types+ PcbnewExpr(..)+, PcbnewModule(..)+, PcbnewItem(..)+, PcbnewAttribute(..)+-- * Attribute types+, PcbnewDrillT(..)+, PcbnewAtT(..)+, PcbnewLayerT(..)+, PcbnewPadShapeT(..)+, PcbnewPadTypeT(..)+, PcbnewFpTextTypeT(..)+, PcbnewXyzT+-- * Lenses and other getters/setters+, moduleItems+, moduleAttrs+, itemLayers+, padAttributes+, atX+, atY+, itemsOn+-- * String conversion+, strToLayer+, layerToStr+, strToPadType+, fpPadTypeToStr+, strToPadShape+, fpPadShapeToStr+, strToFpTextType+, fpTextTypeToStr+-- * Default (empty) instances+, defaultPcbnewModule+, defaultPcbnewFpText+, defaultPcbnewFpLine+, defaultPcbnewFpCircle+, defaultPcbnewFpArc+, defaultPcbnewFpPoly+, defaultPcbnewPad+, defaultPcbnewDrillT+, defaultPcbnewFont+, defaultPcbnewModel+, defaultPcbnewAtT+)+where+import Lens.Family2+import Data.AEq+import Data.Tuple (swap)+import Data.Maybe+import Data.Foldable (foldMap)++import Data.Kicad.SExpr.SExpr++data PcbnewExpr = PcbnewExprModule PcbnewModule+ | PcbnewExprItem PcbnewItem+ | PcbnewExprAttribute PcbnewAttribute+ deriving (Show, Eq)++instance AEq PcbnewExpr where+ PcbnewExprModule x ~== PcbnewExprModule y = x ~== y+ PcbnewExprItem x ~== PcbnewExprItem y = x ~== y+ PcbnewExprAttribute x ~== PcbnewExprAttribute y = x ~== y+ _ ~== _ = False++instance SExpressable PcbnewExpr where+ toSExpr (PcbnewExprModule x) = toSExpr x+ toSExpr (PcbnewExprItem x) = toSExpr x+ toSExpr (PcbnewExprAttribute x) = toSExpr x++data PcbnewModule = PcbnewModule { pcbnewModuleName :: String+ , pcbnewModuleLayer :: PcbnewLayerT+ , pcbnewModuleAttrs :: [PcbnewAttribute]+ , pcbnewModuleItems :: [PcbnewItem]+ }+ deriving (Show, Eq)++instance SExpressable PcbnewModule where+ toSExpr (PcbnewModule name l attrs items) =+ List $ [ AtomKey KeyModule+ , AtomStr name+ , toSExpr (PcbnewLayer l)+ ] ++ map toSExpr attrs+ ++ map toSExpr items++defaultPcbnewModule :: PcbnewModule+defaultPcbnewModule = PcbnewModule "" FCu [] []++moduleItems :: Functor f => LensLike' f PcbnewModule [PcbnewItem]+moduleItems f (PcbnewModule n l a i) = PcbnewModule n l a `fmap` f i++moduleAttrs :: Functor f => LensLike' f PcbnewModule [PcbnewAttribute]+moduleAttrs f (PcbnewModule n l a i) = (\a' -> PcbnewModule n l a' i) `fmap` f a++instance AEq PcbnewModule where+ PcbnewModule n1 l1 as1 is1 ~== PcbnewModule n2 l2 as2 is2 =+ n1 == n2+ && l1 == l2+ && as1 ~== as2+ && is1 ~== is2++data PcbnewItem = PcbnewFpText { fpTextType :: PcbnewFpTextTypeT+ , fpTextStr :: String+ , itemAt :: PcbnewAtT+ , itemLayer :: PcbnewLayerT+ , fpTextHide :: Bool+ , itemSize :: (Double, Double)+ , fpTextThickness :: Double+ , fpTextItalic :: Bool+ }+ | PcbnewFpLine { itemStart :: (Double, Double)+ , itemEnd :: (Double, Double)+ , itemLayer :: PcbnewLayerT+ , itemWidth :: Double+ }+ | PcbnewFpCircle { itemStart :: (Double, Double)+ , itemEnd :: (Double, Double)+ , itemLayer :: PcbnewLayerT+ , itemWidth :: Double+ }+ | PcbnewFpArc { itemStart :: (Double, Double)+ , itemEnd :: (Double, Double)+ , fpArcAngle :: Double+ , itemLayer :: PcbnewLayerT+ , itemWidth :: Double+ }+ | PcbnewFpPoly { fpPolyPts :: [(Double, Double)]+ , itemLayer :: PcbnewLayerT+ , itemWidth :: Double+ }+ | PcbnewPad { padNumber :: String+ , padType :: PcbnewPadTypeT+ , padShape :: PcbnewPadShapeT+ , itemAt :: PcbnewAtT+ , itemSize :: (Double, Double)+ , padLayers :: [PcbnewLayerT]+ , padAttributes_ :: [PcbnewAttribute]+ }+ deriving (Show, Eq)++instance SExpressable PcbnewItem where+ toSExpr (PcbnewFpText t s a l h si th i) =+ List $ [ AtomKey KeyFpText+ , AtomStr $ fpTextTypeToStr t+ , AtomStr s+ , toSExpr (PcbnewAt a)+ , toSExpr (PcbnewLayer l)+ ] ++ [AtomStr "hide" | h] +++ [toSExpr $ PcbnewFpTextEffects $ PcbnewFont si th i]+ toSExpr (PcbnewFpLine s e l w) =+ List [ AtomKey KeyFpLine+ , toSExpr (PcbnewStart s)+ , toSExpr (PcbnewEnd e)+ , toSExpr (PcbnewLayer l)+ , toSExpr (PcbnewWidth w)+ ]+ toSExpr (PcbnewFpCircle s e l w) =+ List [ AtomKey KeyFpCircle+ , toSExpr (PcbnewStart s)+ , toSExpr (PcbnewEnd e)+ , toSExpr (PcbnewLayer l)+ , toSExpr (PcbnewWidth w)+ ]+ toSExpr (PcbnewFpArc s e a l w) =+ List [ AtomKey KeyFpArc+ , toSExpr (PcbnewStart s)+ , toSExpr (PcbnewEnd e)+ , toSExpr (PcbnewAngle a)+ , toSExpr (PcbnewLayer l)+ , toSExpr (PcbnewWidth w)+ ]+ toSExpr (PcbnewFpPoly ps l w) =+ List [ AtomKey KeyFpPoly+ , toSExpr (PcbnewPts ps)+ , toSExpr (PcbnewLayer l)+ , toSExpr (PcbnewWidth w)+ ]+ toSExpr (PcbnewPad n t s a si l attrs) =+ List $ [ AtomKey KeyPad+ , AtomStr n+ , AtomStr $ fpPadTypeToStr t+ , AtomStr $ fpPadShapeToStr s+ , toSExpr $ PcbnewAt a+ , toSExpr $ PcbnewSize si+ , toSExpr $ PcbnewLayers l+ ] ++ map toSExpr attrs++itemLayers :: Functor f => LensLike' f PcbnewItem [PcbnewLayerT]+itemLayers f item@(PcbnewPad { }) =+ (\ls -> item {padLayers = ls}) `fmap` f (padLayers item)+itemLayers f item = update `fmap` f [itemLayer item]+ where update [] = item+ update ls = item {itemLayer = head ls}++padAttributes :: Functor f => LensLike' f PcbnewItem [PcbnewAttribute]+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) =+ t1 == t2+ && s1 == s2+ && a1 ~== a2+ && l1 == l2+ && h1 == h2+ && si1 ~== si2+ && th1 ~== th2+ && i1 == i2+ (PcbnewFpLine s1 e1 l1 w1) ~== (PcbnewFpLine s2 e2 l2 w2) =+ s1 ~== s2+ && e1 ~== e2+ && l1 == l2+ && w1 ~== w2+ (PcbnewFpCircle s1 e1 l1 w1) ~== (PcbnewFpCircle s2 e2 l2 w2) =+ s1 ~== s2+ && e1 ~== e2+ && l1 == l2+ && w1 ~== w2+ (PcbnewFpArc s1 e1 a1 l1 w1) ~== (PcbnewFpArc s2 e2 a2 l2 w2) =+ s1 ~== s2+ && e1 ~== e2+ && a1 ~== a2+ && l1 == l2+ && w1 ~== w2+ (PcbnewFpPoly ps1 l1 w1) ~== (PcbnewFpPoly ps2 l2 w2) =+ ps1 ~== ps2+ && l1 == l2+ && w1 ~== w2+ (PcbnewPad n1 t1 s1 a1 si1 l1 attrs1)+ ~== (PcbnewPad n2 t2 s2 a2 si2 l2 attrs2) =+ n1 == n2+ && t1 == t2+ && s1 == s2+ && a1 ~== a2+ && si1 ~== si2+ && l1 == l2+ && attrs1 ~== attrs2+ x ~== y = x == y++defaultPcbnewFpText :: PcbnewItem+defaultPcbnewFpText = PcbnewFpText { fpTextType = FpTextUser+ , fpTextStr = ""+ , itemAt = defaultPcbnewAtT+ , itemLayer = FSilkS+ , fpTextHide = False+ , itemSize = (1.0, 1.0)+ , fpTextThickness = 1.0+ , fpTextItalic = False+ }++defaultPcbnewFpLine :: PcbnewItem+defaultPcbnewFpLine = PcbnewFpLine { itemStart = (0,0)+ , itemEnd = (0,0)+ , itemLayer = FSilkS+ , itemWidth = 0.15+ }++defaultPcbnewFpCircle :: PcbnewItem+defaultPcbnewFpCircle = PcbnewFpCircle { itemStart = (0,0)+ , itemEnd = (0,0)+ , itemLayer = FSilkS+ , itemWidth = 0.15+ }+defaultPcbnewFpArc :: PcbnewItem+defaultPcbnewFpArc = PcbnewFpArc { itemStart = (0,0)+ , itemEnd = (0,0)+ , fpArcAngle = 0+ , itemLayer = FSilkS+ , itemWidth = 0.15+ }++defaultPcbnewFpPoly :: PcbnewItem+defaultPcbnewFpPoly = PcbnewFpPoly { fpPolyPts = []+ , itemLayer = FSilkS+ , itemWidth = 0.15+ }++defaultPcbnewPad :: PcbnewItem+defaultPcbnewPad = PcbnewPad { padNumber = ""+ , padType = ThruHole+ , padShape = Circle+ , itemAt = defaultPcbnewAtT+ , itemSize = (0,0)+ , padLayers = []+ , padAttributes_ = []+ }++data PcbnewDrillT = PcbnewDrillT { pcbnewDrillSize :: Maybe (Double, Double)+ , pcbnewDrillOval :: Bool+ , pcbnewDrillOffset :: Maybe (Double, Double)+ }+ deriving (Show, Eq)++defaultPcbnewDrillT :: PcbnewDrillT+defaultPcbnewDrillT = PcbnewDrillT Nothing False Nothing++instance AEq PcbnewDrillT where+ PcbnewDrillT s1 o1 off1 ~== PcbnewDrillT s2 o2 off2+ = s1 ~== s2 && o1 == o2 && off1 ~== off2++data PcbnewAttribute = PcbnewLayer PcbnewLayerT+ | PcbnewAt PcbnewAtT+ | PcbnewFpTextType PcbnewFpTextTypeT+ | PcbnewSize (Double, Double)+ | PcbnewThickness Double+ | PcbnewTedit String+ | PcbnewItalic+ | PcbnewHide+ | PcbnewLocked+ | PcbnewStart (Double, Double)+ | PcbnewEnd (Double, Double)+ | PcbnewWidth Double+ | PcbnewDescr String+ | PcbnewTags String+ | PcbnewAttr String+ | PcbnewLayers [PcbnewLayerT]+ | PcbnewDrill PcbnewDrillT+ | PcbnewRectDelta (Double, Double)+ | PcbnewFpTextEffects PcbnewAttribute+ | PcbnewFont { pcbnewFontSize :: (Double, Double)+ , pcbnewFontThickness :: Double+ , pcbnewFontItalic :: Bool+ }+ | PcbnewAngle Double+ | PcbnewXy (Double, Double)+ | PcbnewPts [(Double, Double)]+ | PcbnewModel { pcbnewModelPath :: String+ , pcbnewModelAt :: PcbnewXyzT+ , pcbnewModelScale :: PcbnewXyzT+ , pcbnewModelRotate :: PcbnewXyzT+ }+ | PcbnewModelAt PcbnewAttribute+ | PcbnewModelScale PcbnewAttribute+ | PcbnewModelRotate PcbnewAttribute+ | PcbnewXyz PcbnewXyzT+ | PcbnewCenter (Double, Double)+ | PcbnewClearance Double+ | PcbnewMaskMargin Double+ | PcbnewPasteMargin Double+ | PcbnewPasteMarginRatio Double+ | PcbnewOffset (Double, Double)+ | PcbnewAutoplaceCost90 Int+ | PcbnewAutoplaceCost180 Int+ | PcbnewZoneConnect Int+ | PcbnewThermalWidth Double+ | PcbnewThermalGap Double+ deriving (Show, Eq)++type PcbnewXyzT = (Double, Double, Double)++instance SExpressable PcbnewAttribute where+ toSExpr (PcbnewLayer l) = List [ AtomKey KeyLayer+ , AtomStr $ layerToStr l+ ]+ toSExpr (PcbnewAt (PcbnewAtT (x,y) o)) =+ List $ [ AtomKey KeyAt+ , AtomDbl x+ , AtomDbl y+ ] ++ [AtomDbl o | o /= 0]+ toSExpr (PcbnewLayers ls) =+ List (AtomKey KeyLayers : map (AtomStr . layerToStr) ls)+ toSExpr (PcbnewFont s t i) =+ List $ [ AtomKey KeyFont, toSExpr (PcbnewSize s)+ , toSExpr (PcbnewThickness t)+ ] ++ [AtomStr "italic" | i]+ toSExpr (PcbnewPts xys) =+ List $ AtomKey KeyPts : map (toSExpr . PcbnewXy) xys+ toSExpr (PcbnewModel p a s r) =+ List [AtomKey KeyModel+ , AtomStr p+ , toSExpr (PcbnewModelAt (PcbnewXyz a))+ , toSExpr (PcbnewModelScale (PcbnewXyz s))+ , toSExpr (PcbnewModelRotate (PcbnewXyz r))+ ]+ toSExpr (PcbnewDrill (PcbnewDrillT s o off)) =+ List $ [AtomKey KeyDrill]+ ++ [AtomStr "oval" | o]+ ++ (if o && isJust s+ then [AtomDbl (fst (fromJust s)), AtomDbl (snd (fromJust s))]+ else [AtomDbl (fst (fromJust s)) | isJust s])+ ++ [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 (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 (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 (PcbnewSize xy) = toSxDD KeySize xy+ toSExpr (PcbnewStart xy) = toSxDD KeyStart xy+ toSExpr (PcbnewCenter xy) = toSxDD KeyCenter xy+ toSExpr (PcbnewRectDelta xy) = toSxDD KeyRectDelta xy+ toSExpr (PcbnewEnd xy) = toSxDD KeyEnd xy+ toSExpr (PcbnewXy xy) = toSxDD KeyXy xy+ toSExpr (PcbnewOffset xy) = toSxDD KeyOffset xy+ toSExpr (PcbnewTedit s) = toSxStr KeyTedit s+ toSExpr (PcbnewDescr s) = toSxStr KeyDescr s+ toSExpr (PcbnewTags s) = toSxStr KeyTags s+ toSExpr (PcbnewAttr s) = toSxStr KeyAttr s+ toSExpr PcbnewItalic = AtomStr "italic"+ toSExpr PcbnewHide = AtomStr "hide"+ 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)++toSxD :: Keyword -> Double -> SExpr+toSxD kw d = List [AtomKey kw, AtomDbl d]++toSxDD :: Keyword -> (Double, Double) -> SExpr+toSxDD kw (x,y) = List [AtomKey kw, AtomDbl x, AtomDbl y]++toSxStr :: Keyword -> String -> SExpr+toSxStr kw s = List [AtomKey kw, AtomStr s]++instance AEq PcbnewAttribute where+ (PcbnewAt x) ~== (PcbnewAt y) = x ~== y+ (PcbnewSize x) ~== (PcbnewSize y) = x ~== y+ (PcbnewCenter x) ~== (PcbnewCenter y) = x ~== y+ (PcbnewThickness x) ~== (PcbnewThickness y) = x ~== y+ (PcbnewStart x) ~== (PcbnewStart y) = x ~== y+ (PcbnewEnd x) ~== (PcbnewEnd y) = x ~== y+ (PcbnewWidth x) ~== (PcbnewWidth y) = x ~== y+ (PcbnewDrill x) ~== (PcbnewDrill y) = x ~== y+ (PcbnewRectDelta x) ~== (PcbnewRectDelta y) = x ~== y+ (PcbnewAngle x) ~== (PcbnewAngle y) = x ~== y+ (PcbnewXy x) ~== (PcbnewXy y) = x ~== y+ (PcbnewPts x) ~== (PcbnewPts y) = x ~== y+ (PcbnewXyz x) ~== (PcbnewXyz y) = x ~== y+ (PcbnewOffset x) ~== (PcbnewOffset y) = x ~== y+ (PcbnewClearance x) ~== (PcbnewClearance y) = x ~== y+ (PcbnewMaskMargin x) ~== (PcbnewMaskMargin y) = x ~== y+ (PcbnewPasteMargin x) ~== (PcbnewPasteMargin y) = x ~== y+ (PcbnewPasteMarginRatio x) ~== (PcbnewPasteMarginRatio y) = x ~== y+ (PcbnewThermalWidth x) ~== (PcbnewThermalWidth y) = x ~== y+ (PcbnewThermalGap x) ~== (PcbnewThermalGap y) = x ~== y+ (PcbnewModelAt x) ~== (PcbnewModelAt y) = x ~== y+ (PcbnewModelScale x) ~== (PcbnewModelScale y) = x ~== y+ (PcbnewModelRotate x) ~== (PcbnewModelRotate y) = x ~== y+ (PcbnewModel p1 a1 s1 r1) ~== (PcbnewModel p2 a2 s2 r2) =+ p1 == p2 && a1 ~== a2 && s1 ~== s2 && r1 ~== r2+ (PcbnewFont s1 t1 i1) ~== (PcbnewFont s2 t2 i2) =+ s1 ~== s2 && t1 ~== t2 && i1 == i2+ x ~== y = x == y++defaultPcbnewFont :: PcbnewAttribute+defaultPcbnewFont = PcbnewFont { pcbnewFontSize = (1.0, 1.0)+ , pcbnewFontThickness = 1.0+ , pcbnewFontItalic = False+ }++defaultPcbnewModel :: PcbnewAttribute+defaultPcbnewModel = PcbnewModel { pcbnewModelPath = ""+ , pcbnewModelAt = (0,0,0)+ , pcbnewModelScale = (0,0,0)+ , pcbnewModelRotate = (0,0,0)+ }++data PcbnewLayerT = FSilkS | FCu | FPaste | FMask | BSilkS+ | BCu | BPaste | BMask | DwgsUser | CmtsUser+ | FAdhes | AllSilk | FandBCu | AllCu | AllMask+ | EdgeCuts | FCrtYd | BCrtYd+ | Inner1Cu | Inner2Cu | Inner3Cu | Inner4Cu | Inner5Cu+ | Inner6Cu | Inner7Cu | Inner8Cu | Inner9Cu | Inner10Cu+ | Inner11Cu | Inner12Cu | Inner13Cu | Inner14Cu | Inner15Cu+ | Inner16Cu | Inner17Cu | Inner18Cu | Inner19Cu | Inner20Cu+ | Inner21Cu | Inner22Cu | Inner23Cu | Inner24Cu | Inner25Cu+ | Inner26Cu | Inner27Cu | Inner28Cu | Inner29Cu | Inner30Cu+ | Inner31Cu | Inner32Cu+ deriving (Show, Eq, Enum, Bounded)++strToLayerMap :: [(String, PcbnewLayerT)]+strToLayerMap =+ [ ("F.SilkS" , FSilkS )+ , ("F.Cu" , FCu )+ , ("F.Paste" , FPaste )+ , ("F.Mask" , FMask )+ , ("B.SilkS" , BSilkS )+ , ("B.Cu" , BCu )+ , ("B.Paste" , BPaste )+ , ("B.Mask" , BMask )+ , ("Dwgs.User" , DwgsUser)+ , ("Cmts.User" , CmtsUser)+ , ("F.Adhes" , FAdhes)+ , ("F&B.Cu" , FandBCu)+ , ("*.Cu" , AllCu )+ , ("*.Mask" , AllMask)+ , ("*.SilkS" , AllSilk)+ , ("F.CrtYd" , FCrtYd)+ , ("B.CrtYd" , BCrtYd)+ , ("Edge.Cuts" , EdgeCuts)+ , ("Inner1.Cu" , Inner1Cu)+ , ("Inner2.Cu" , Inner2Cu)+ , ("Inner3.Cu" , Inner3Cu)+ , ("Inner4.Cu" , Inner4Cu)+ , ("Inner5.Cu" , Inner5Cu)+ , ("Inner6.Cu" , Inner6Cu)+ , ("Inner7.Cu" , Inner7Cu)+ , ("Inner8.Cu" , Inner8Cu)+ , ("Inner9.Cu" , Inner9Cu)+ , ("Inner10.Cu", Inner10Cu)+ , ("Inner11.Cu", Inner11Cu)+ , ("Inner12.Cu", Inner12Cu)+ , ("Inner13.Cu", Inner13Cu)+ , ("Inner14.Cu", Inner14Cu)+ , ("Inner15.Cu", Inner15Cu)+ , ("Inner16.Cu", Inner16Cu)+ , ("Inner17.Cu", Inner17Cu)+ , ("Inner18.Cu", Inner18Cu)+ , ("Inner19.Cu", Inner19Cu)+ , ("Inner20.Cu", Inner20Cu)+ , ("Inner21.Cu", Inner21Cu)+ , ("Inner22.Cu", Inner22Cu)+ , ("Inner23.Cu", Inner23Cu)+ , ("Inner24.Cu", Inner24Cu)+ , ("Inner25.Cu", Inner25Cu)+ , ("Inner26.Cu", Inner26Cu)+ , ("Inner27.Cu", Inner27Cu)+ , ("Inner28.Cu", Inner28Cu)+ , ("Inner29.Cu", Inner29Cu)+ , ("Inner30.Cu", Inner30Cu)+ , ("Inner31.Cu", Inner31Cu)+ , ("Inner32.Cu", Inner32Cu)+ ]++strToLayer :: String -> Maybe PcbnewLayerT+strToLayer s = lookup s strToLayerMap++layerToStr :: PcbnewLayerT -> String+layerToStr l = fromMaybe "" $ lookup l $ map swap strToLayerMap++itemsOn :: [PcbnewLayerT] -> [PcbnewItem] -> [PcbnewItem]+itemsOn = foldMap itemsOn'+ where itemsOn' :: PcbnewLayerT -> [PcbnewItem] -> [PcbnewItem]+ itemsOn' layer = filter ((layer `elem`) . view itemLayers)++data PcbnewPadTypeT = ThruHole | SMD | Connect | NPThruHole+ deriving (Show, Eq, Enum, Bounded)++strToPadTypeMap :: [(String, PcbnewPadTypeT)]+strToPadTypeMap =+ [ ("smd" , SMD)+ , ("thru_hole" , ThruHole)+ , ("connect" , Connect)+ , ("np_thru_hole" , NPThruHole)+ ]++strToPadType :: String -> Maybe PcbnewPadTypeT+strToPadType s = lookup s strToPadTypeMap++fpPadTypeToStr :: PcbnewPadTypeT -> String+fpPadTypeToStr t = fromMaybe "" $ lookup t $ map swap strToPadTypeMap++data PcbnewPadShapeT = Circle | Oval | Rect | Trapezoid+ deriving (Show, Eq, Enum, Bounded)++strToPadShapeMap :: [(String, PcbnewPadShapeT)]+strToPadShapeMap = [ ("circle" , Circle)+ , ("oval" , Oval)+ , ("rect" , Rect)+ , ("trapezoid", Trapezoid)+ ]++strToPadShape :: String -> Maybe PcbnewPadShapeT+strToPadShape s = lookup s strToPadShapeMap++fpPadShapeToStr :: PcbnewPadShapeT -> String+fpPadShapeToStr t = fromMaybe "" $ lookup t $ map swap strToPadShapeMap++data PcbnewAtT = PcbnewAtT { pcbnewAtPoint :: (Double, Double)+ , pcbnewAtOrientation :: Double+ }+ deriving (Show, Eq)++instance AEq PcbnewAtT where+ (PcbnewAtT p1 o1) ~== (PcbnewAtT p2 o2) = p1 ~== p2 && o1 ~== o2++defaultPcbnewAtT :: PcbnewAtT+defaultPcbnewAtT = PcbnewAtT { pcbnewAtPoint = (0,0)+ , pcbnewAtOrientation = 0+ }++atX :: Functor f => LensLike' f PcbnewAtT Double+atX f (PcbnewAtT (x,y) o) = (\x' -> PcbnewAtT (x',y) o) `fmap` f x++atY :: Functor f => LensLike' f PcbnewAtT Double+atY f (PcbnewAtT (x,y) o) = (\y' -> PcbnewAtT (x,y') o) `fmap` f y++data PcbnewFpTextTypeT = FpTextReference | FpTextValue | FpTextUser+ deriving (Show, Eq, Enum, Bounded)+++strToFpTextTypeMap :: [(String, PcbnewFpTextTypeT)]+strToFpTextTypeMap =+ [ ("reference", FpTextReference)+ , ("value" , FpTextValue)+ , ("user" , FpTextUser)+ ]++strToFpTextType :: String -> Maybe PcbnewFpTextTypeT+strToFpTextType s = lookup s strToFpTextTypeMap++fpTextTypeToStr :: PcbnewFpTextTypeT -> String+fpTextTypeToStr t = fromMaybe "" $ lookup t $ map swap strToFpTextTypeMap
+ Data/Kicad/PcbnewExpr/Write.hs view
@@ -0,0 +1,19 @@+module Data.Kicad.PcbnewExpr.Write+(+ pretty+, write+)+where+import Text.PrettyPrint.Compact++import Data.Kicad.PcbnewExpr.PcbnewExpr+import qualified Data.Kicad.SExpr as SExpr++{-| Pretty-print a 'PcbnewExpr' as a readable s-expression 'Doc'.-}+pretty :: PcbnewExpr -> Doc+pretty = SExpr.pretty . SExpr.toSExpr++{-| Serialize a 'PcbnewExpr' as a compact s-expression 'String'. -}+write :: PcbnewExpr -> String+write = SExpr.write . SExpr.toSExpr+
+ Data/Kicad/SExpr.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+module Data.Kicad.SExpr+(+-- * Types+ SExpr(..)+, Keyword(..)+, SExpressable(..)+-- * Writing+, pretty+, write+, writeKeyword+-- * Parsing+, parse+)+where+import Data.Kicad.SExpr.SExpr+import Data.Kicad.SExpr.Write+import Data.Kicad.SExpr.Parse
+ Data/Kicad/SExpr/Parse.hs view
@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Data.Kicad.SExpr.Parse+( parse+)+where+import Text.ParserCombinators.Parsec hiding (spaces, parse)+import qualified Text.ParserCombinators.Parsec as Parsec (parse)+import Text.ParserCombinators.Parsec.Number+import Control.Monad++import Data.Kicad.SExpr.SExpr+import Data.Kicad.SExpr.Write (writeKeyword)++{-| Parse a 'String' as a 'SExpr' or return an error. -}+parse :: String -> Either String SExpr+parse input = case Parsec.parse parseList "SExpr" input of+ Left err -> Left $ "Parse Error: " ++ show err+ Right val -> Right val++parseList :: Parser SExpr+parseList = do+ char '('+ spaces+ first <- parseKeyword+ spaces+ rest <- let parseRest = try parseAtom `sepEndBy` spaces in case first of+ AtomKey KeyFpText -> do t <- parseString+ <?> "string designating type e.g. 'user'"+ spaces1+ s <- parseString+ spaces+ r <- parseRest+ return (t:s:r)+ AtomKey KeyModule -> do t <- parseString+ spaces+ r <- parseRest+ return (t:r)+ AtomKey KeyTedit -> do s <- parseString+ spaces+ return [s]+ AtomKey KeyDescr -> do s <- parseString+ spaces+ return [s]+ AtomKey KeyPad -> do n <- parseString+ spaces1+ t <- parseString+ <?> "string designating type e.g. 'smd'"+ spaces1+ s <- parseString+ spaces+ r <- parseRest+ return (n:t:s:r)+ _ -> parseRest+ spaces+ char ')'+ spaces+ return $ List (first:rest)++parseAtom :: Parser SExpr+parseAtom = try parseDouble+ <|> try parseString+ <|> try parseList+ <?> "a double, string or s-expression"++parseOneKeyword :: Keyword -> Parser SExpr+parseOneKeyword kw = try $ string (writeKeyword kw) >> return (AtomKey kw)++parseKeyword :: Parser SExpr+parseKeyword = choice (map parseOneKeyword [minBound..maxBound]) <?> "keyword"++parseString :: Parser SExpr+parseString = liftM AtomStr (parseQuotedString <|> parseUnquotedString <?> "string")+ where+ parseQuotedString = do+ char '"'+ x <- many (noneOf "\\\"" <|> (char '\\' >> anyChar))+ char '"'+ return x+ parseUnquotedString = many1 (noneOf "\" ()\r\n")++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+ x <- floating3 True+ lookAhead (char ')' <|> spaceChar)+ return $ AtomDbl $ negate_or_id x++spaces1 = skipMany1 spaceChar+spaces = skipMany spaceChar+spaceChar = newline <|> space
+ Data/Kicad/SExpr/SExpr.hs view
@@ -0,0 +1,62 @@+module Data.Kicad.SExpr.SExpr+( SExpr(..)+, Keyword(..)+, SExpressable(..)+)+where++data SExpr = AtomKey Keyword+ | AtomStr String+ | AtomDbl Double+ | List [SExpr]+ deriving (Show, Eq)++{- The keywords _must_ be "Key" ++ camel-case version of the ones in the+ - kicad_mod files as the parser and writer use the derived 'Show' instance.+ - The parser will also try them in the order they appear below so KeyAttr has+ - to appear before KeyAt for instance. -}+data Keyword = KeyZoneConnect+ | KeyXyz+ | KeyXy+ | KeyWidth+ | KeyThickness+ | KeyThermalWidth+ | KeyThermalGap+ | KeyTedit+ | KeyTags+ | KeyStart+ | KeySolderPasteMarginRatio+ | KeySolderPasteMargin+ | KeySolderMaskMargin+ | KeySize+ | KeyScale+ | KeyRotate+ | KeyRectDelta+ | KeyPts+ | KeyPad+ | KeyOffset+ | KeyModule+ | KeyModel+ | KeyLayers+ | KeyLayer+ | KeyFpText+ | KeyFpPoly+ | KeyFpLine+ | KeyFpCircle+ | KeyFpArc+ | KeyFont+ | KeyEnd+ | KeyEffects+ | KeyDrill+ | KeyDescr+ | KeyClearance+ | KeyCenter+ | KeyAutoplaceCost90+ | KeyAutoplaceCost180+ | KeyAttr+ | KeyAt+ | KeyAngle+ deriving (Show, Eq, Enum, Bounded)++class SExpressable a where+ toSExpr :: a -> SExpr
+ Data/Kicad/SExpr/Write.hs view
@@ -0,0 +1,45 @@+module Data.Kicad.SExpr.Write+( pretty+, write+, writeKeyword+)+where+import Data.Char (toLower, isLower, isNumber)+import Data.List (intercalate)+import Text.PrettyPrint.Compact++import Data.Kicad.SExpr.SExpr++{-| Pretty-print a 'SExpr' as a readable 'Doc'. -}+pretty :: SExpr -> Doc+pretty (List xs) = text "(" <> align (sep $ map pretty xs) <> text ")"+pretty atm = text $ write atm+++{-| Serialize an SExpr as a compact s-expression 'String'. -}+write :: SExpr -> String+write (AtomKey kw) = writeKeyword kw+write (AtomStr atm) | (atm == "")+ || head atm `elem` '.':'-':['0'..'9']+ || foldr+ (\c z -> z || c `elem` ')':'(':'\\':'\"':['\0'..' '])+ False atm = show atm -- escaped string with quotes+ | otherwise = atm+-- this should just be printf "%g" but that doesn't work as it should+write (AtomDbl atm) = strip_zeros $ break (== '.') $ show atm+ where strip_zeros (s1,s2) = s1 ++ dot_if_needed (reverse+ $ dropWhile (=='0') $ reverse s2)+ dot_if_needed s = if s == "." then "" else s+write (List sxs) = "(" ++ unwords (map write sxs) ++ ")"++{-| Write a 'Keyword' as a 'String'. Removes \"Key\" from the 'Show'+ instance and converts the rest to underscore (e.g KeyFpTextType becomes+ "fp_text_type"). -}+writeKeyword :: Keyword -> String+writeKeyword = intercalate "_" . splitCapWords . drop 3 . show+ where+ splitCapWords "" = []+ splitCapWords (x:xs) =+ let (word, rest) = span (\c -> isLower c || isNumber c) xs+ in (toLower x : word) : splitCapWords rest+
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Kaspar Emanuel++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ kicad-data.cabal view
@@ -0,0 +1,61 @@+name: kicad-data+version: 0.1.0.0+synopsis: Parser and writer for KiCad files.+license: MIT+license-file: LICENSE+author: Kaspar Emanuel+maintainer: kaspar.emanuel@gmail.com+homepage: http://github.com/kasbah/haskell-kicad-data+bug-reports: http://github.com/kasbah/haskell-kicad-data/issues+copyright: 2014+category: Data+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++source-repository head+ type: git+ location: git@github.com:kasbah/haskell-kicad-data++library+ ghc-options: -Wall+ exposed-modules:+ Data.Kicad.PcbnewExpr+ , Data.Kicad.PcbnewExpr.PcbnewExpr+ , Data.Kicad.PcbnewExpr.Parse+ , Data.Kicad.PcbnewExpr.Write+ , Data.Kicad.SExpr+ , Data.Kicad.SExpr.SExpr+ , Data.Kicad.SExpr.Parse+ , Data.Kicad.SExpr.Write+ -- other-modules:+ -- other-extensions:+ build-depends:+ base >=4.6 && <4.8+ , parsec >=3.1 && <3.2+ , parsec-numbers >= 0.1.0 && <0.2.0+ , lens-family >= 1.1 && <1.2+ , ieee754 >= 0.7.4 && <0.8+ , pretty-compact >= 1.0 && < 2+ -- hs-source-dirs:+ default-language: Haskell2010++test-suite kicad-data-quickcheck+ type: exitcode-stdio-1.0+ x-uses-tf: true+ ghc-options: -Wall -fno-warn-unused-do-bind+ hs-source-dirs: tests+ default-language: Haskell2010+ main-is: Test.hs++ build-depends:+ base >= 4 && < 5+ , parsec >=3.1 && <3.2+ , parsec-numbers >= 0.1.0 && <0.2.0+ , lens-family >= 1.1 && <1.2+ , ieee754 >= 0.7.4 && <0.8+ , QuickCheck >= 2+ , test-framework >= 0.8 && < 1+ , test-framework-quickcheck2 >= 0.3 && < 1+ , pretty-compact >= 1.0 && < 2+ , kicad-data
+ tests/Test.hs view
@@ -0,0 +1,9 @@+import Test.Framework (defaultMain, testGroup)++import qualified SExpr+import qualified PcbnewExpr++main :: IO ()+main = defaultMain [ testGroup "SExpr" SExpr.tests+ , testGroup "PcbnewExpr" PcbnewExpr.tests+ ]