Add support for TF command (FileAttribute) from GerberX2

gerber/gerber.cabal

@@ -11,6 +11,16 @@ cabal-version:       >= 2.0
 
 library
   exposed-modules:     Gerber.ApertureDefinition
+                       Gerber.Attribute
+                       Gerber.Attribute.Attribute
+                       Gerber.Attribute.CreationDate
+                       Gerber.Attribute.FileFunction
+                       Gerber.Attribute.FileFunction.Copper
+                       Gerber.Attribute.FileFunction.Drill
+                       Gerber.Attribute.FileFunction.Types
+                       Gerber.Attribute.FilePolarity
+                       Gerber.Attribute.GenerationSoftware
+                       Gerber.Attribute.Part
                        Gerber.Command
                        Gerber.DCodeNumber
                        Gerber.EncodedDecimal
@@ -27,12 +37,16 @@ library
                        Gerber.StepRepeat
                        Gerber.Unit
   build-depends:       base ^>= 4.12 || ^>= 4.13 || ^>= 4.14
-                     , megaparsec ^>= 7.0
-                     , text >=1.2 && <1.3
-                     , generic-deriving
+                     , base16-bytestring < 1
+                     , bytestring
                      , containers
-                     , monoid-extras
                      , foldl
+                     , generic-deriving
+                     , megaparsec ^>= 7.0
+                     , monoid-extras
+                     , text >=1.2 && <1.3
+                     , time
+                     , uuid-types
   hs-source-dirs:      lib
   default-language:    Haskell2010
   ghc-options:         -Wall

gerber/lib/Gerber/Attribute.hs

@@ -0,0 +1,40 @@
+{-# language OverloadedStrings #-}
+
+module Gerber.Attribute
+  ( FileAttribute(..)
+  , parseFileAttribute
+  ) where
+
+-- gerber
+import Gerber.Attribute.Attribute ( Attribute( Attribute ) )
+import Gerber.Attribute.CreationDate ( CreationDate, parseCreationDate )
+import Gerber.Attribute.FileFunction ( FileFunction, parseFileFunction )
+import Gerber.Attribute.FilePolarity ( FilePolarity, parseFilePolarity )
+import Gerber.Attribute.GenerationSoftware ( GenerationSoftware, parseGenerationSoftware )
+import Gerber.Attribute.MD5 ( MD5, parseMD5 )
+import Gerber.Attribute.Part ( Part, parsePart )
+import Gerber.Attribute.ProjectId ( ProjectId, parseProjectId )
+
+
+data FileAttribute
+  = Part !Part
+  | FileFunction !FileFunction
+  | FilePolarity !FilePolarity
+  | GenerationSoftware !GenerationSoftware
+  | CreationDate !CreationDate
+  | ProjectId !ProjectId
+  | MD5 !MD5
+  | UserAttribute !Attribute
+  deriving ( Eq, Show )
+
+
+parseFileAttribute :: MonadFail m => Attribute -> m FileAttribute
+parseFileAttribute attribute@(Attribute name fields) = case name of
+  ".Part" -> Part <$> parsePart fields
+  ".FileFunction" -> FileFunction <$> parseFileFunction fields
+  ".FilePolarity" -> FilePolarity <$> parseFilePolarity fields
+  ".GenerationSoftware" -> GenerationSoftware <$> parseGenerationSoftware fields
+  ".CreationDate" -> CreationDate <$> parseCreationDate fields
+  ".ProjectId" -> ProjectId <$> parseProjectId fields
+  ".MD5" -> MD5 <$> parseMD5 fields
+  _ -> pure (UserAttribute attribute)

gerber/lib/Gerber/Attribute/Attribute.hs

@@ -0,0 +1,17 @@
+module Gerber.Attribute.Attribute
+  ( Attribute(..)
+  , Field
+  ) where
+
+-- text
+import Data.Text ( Text )
+
+
+data Attribute = Attribute
+  { name :: !Text
+  , value :: ![Field]
+  }
+  deriving ( Eq, Show )
+
+
+type Field = Text

gerber/lib/Gerber/Attribute/CreationDate.hs

@@ -0,0 +1,23 @@
+module Gerber.Attribute.CreationDate
+  ( CreationDate(..), parseCreationDate
+  ) where
+
+-- gerber
+import Gerber.Attribute.Attribute ( Field )
+
+-- text
+import Data.Text ( unpack )
+
+-- time
+import Data.Time.Clock ( UTCTime )
+import Data.Time.Format.ISO8601 ( formatParseM, iso8601Format )
+
+
+newtype CreationDate = CreationDate UTCTime
+  deriving ( Eq, Show )
+
+
+parseCreationDate :: MonadFail m => [Field] -> m CreationDate
+parseCreationDate fields = case fields of
+  [field] -> CreationDate <$> formatParseM iso8601Format (unpack field)
+  _ -> fail "Bad .CreationDate: must have exactly 1 field"

gerber/lib/Gerber/Attribute/FileFunction.hs

@@ -0,0 +1,107 @@
+{-# language OverloadedStrings #-}
+
+module Gerber.Attribute.FileFunction
+  ( FileFunction(..), parseFileFunction
+  ) where
+
+-- gerber
+import Gerber.Attribute.Attribute ( Field )
+import Gerber.Attribute.FileFunction.Types
+  ( Copper, parseCopper
+  , Drill, parseDrill
+  , Mask, parseMask
+  , Profile, parseProfile
+  , Side, parseSide
+  )
+
+-- text
+import Data.Text ( unpack )
+
+
+data FileFunction
+  = Copper !Copper
+  | Soldermask !Mask
+  | Legend !Mask
+  | Goldmask !Mask
+  | Silvermask !Mask
+  | Tinmask !Mask
+  | Carbonmask !Mask
+  | Peelablesoldermask !Mask
+  | Glue !Mask
+  | Viatenting !Side
+  | Viafill
+  | Heatsink !Side
+  | Paste !Side
+  | KeepOut !Side
+  | Pads !Side
+  | Scoring !Side
+  | Plated !Drill
+  | NonPlated !Drill
+  | Profile !Profile
+  | Drillmap
+  | FabricationDrawing
+  | ArrayDrawing
+  | AssemblyDrawing !Side
+  | Drawing !Field
+  | Other !Field
+  deriving ( Eq, Show )
+
+
+parseFileFunction :: MonadFail m => [Field] -> m FileFunction
+parseFileFunction [] = fail "Bad .FileFunction: at least 1 field required"
+parseFileFunction (name : values) = case name of
+  "Copper" -> Copper <$> arity2or3 parseCopper
+  "Soldermask" -> Soldermask <$> arity1or2 parseMask
+  "Legend" -> Legend <$> arity1or2 parseMask
+  "Goldmask" -> Goldmask <$> arity1or2 parseMask
+  "Silvermask" -> Silvermask <$> arity1or2 parseMask
+  "Tinmask" -> Tinmask <$> arity1or2 parseMask
+  "Carbonmask" -> Legend <$> arity1or2 parseMask
+  "Peelablasoldermask" -> Peelablesoldermask <$> arity1or2 parseMask
+  "Glue" -> Glue <$> arity1or2 parseMask
+  "Viatenting" -> Viatenting <$> arity1 parseSide
+  "Viafill" -> arity0 $ pure Viafill
+  "Heatsink" -> Heatsink <$> arity1 parseSide
+  "Paste" -> Paste <$> arity1 parseSide
+  "Keep-out" -> KeepOut <$> arity1 parseSide
+  "Scoring" -> Scoring <$> arity1 parseSide
+  "Plated" -> Plated <$> arity3or4 parseDrill
+  "NonPlated" -> NonPlated <$> arity3or4 parseDrill
+  "Profile" -> Profile <$> arity1 parseProfile
+  "Drillmap" -> arity0 $ pure Drillmap
+  "FabricationDrawing" -> arity0 $ pure FabricationDrawing
+  "ArrayDrawing" -> arity0 $ pure ArrayDrawing
+  "AssemblyDrawing" -> AssemblyDrawing <$> arity1 parseSide
+  "Drawing" -> Drawing <$> arity1 pure
+  "Other" -> Other <$> arity1 pure
+  _ -> fail $ "Bad .FileFunction: unknown value " <> unpack name
+  where
+    arity0 f = case values of
+      [] -> f
+      _ -> fail $ message "0"
+
+    arity1 f = case values of
+      [a] -> f a
+      _ -> fail $ message "1"
+
+    arity1or2 f = case values of
+      [a, b] -> f a (Just b)
+      [a] -> f a Nothing
+      _ -> fail $ message "1 or 2"
+
+    arity2or3 f = case values of
+      [a, b, c] -> f a b (Just c)
+      [a, b] -> f a b Nothing
+      _ -> fail $ message "2 or 3"
+
+    arity3or4 f = case values of
+      [a, b, c, d] -> f a b c (Just d)
+      [a, b, c] -> f a b c Nothing
+      _ -> fail $ message "3 or 4"
+
+    message n =
+      "Bad .FileFunction: " <>
+      unpack name <>
+      " field requires " <>
+      n <>
+      " values"

gerber/lib/Gerber/Attribute/FileFunction/Copper.hs

@@ -0,0 +1,37 @@
+{-# language OverloadedStrings #-}
+
+module Gerber.Attribute.FileFunction.Copper
+  ( Mark(..), parseMark
+  , Type(..), parseType
+  ) where
+
+-- gerber
+import Gerber.Attribute.Attribute ( Field )
+
+-- text
+import Data.Text ( unpack )
+
+
+data Mark = Top | Inner | Bottom
+  deriving ( Eq, Show )
+
+
+parseMark :: MonadFail m => Field -> m Mark
+parseMark field = case field of
+  "Top" -> pure Top
+  "Inr" -> pure Inner
+  "Bot" -> pure Bottom
+  _ -> fail $ "Bad Copper.Mark: " <> unpack field
+
+
+data Type = Plane | Signal | Mixed | Hatched
+  deriving ( Eq, Show )
+
+
+parseType :: MonadFail m => Field -> m Type
+parseType field = case field of
+  "Plane" -> pure Plane
+  "Signal" -> pure Signal
+  "Mixed" -> pure Mixed
+  "Hatched" -> pure Hatched
+  _ -> fail $ "Bad Coppper.Type: " <> unpack field

gerber/lib/Gerber/Attribute/FileFunction/Drill.hs

@@ -0,0 +1,37 @@
+{-# language OverloadedStrings #-}
+
+module Gerber.Attribute.FileFunction.Drill
+  ( Type(..), parseType
+  , Via(..), parseVia
+  ) where
+
+-- gerber
+import Gerber.Attribute.Attribute ( Field )
+
+-- text
+import Data.Text ( unpack )
+
+
+data Type = Drill | Route | Mixed
+  deriving ( Eq, Show )
+
+
+parseType :: MonadFail m => Field -> m Type
+parseType field = case field of
+  "Drill" -> pure Drill
+  "Route" -> pure Route
+  "Mixed" -> pure Mixed
+  _ -> fail $ "Bad Drill.Type: " <> unpack field
+
+
+data Via = TH | Blind | Buried
+  deriving ( Eq, Show )
+
+
+parseVia :: MonadFail m => Field -> m Via
+parseVia field = case field of
+  "PTH" -> pure TH
+  "NPTH" -> pure TH
+  "Blind" -> pure Blind
+  "Buried" -> pure Buried
+  _ -> fail $ "Bad Drill.Via: " <> unpack field