diff --git a/avr-shake.cabal b/avr-shake.cabal --- a/avr-shake.cabal +++ b/avr-shake.cabal @@ -1,5 +1,5 @@ name: avr-shake -version: 0.0.0.3 +version: 0.0.1.0 stability: experimental cabal-version: >= 1.6 @@ -22,5 +22,9 @@ ghc-options: -fwarn-unused-imports -fwarn-unused-binds hs-source-dirs: src exposed-modules: Development.Shake.AVR + System.Command.AVRDUDE build-depends: base >= 3 && <5, - shake >= 0.10 && < 0.12 + dependent-sum, + mtl, + process, + shake >= 0.10 && < 0.14 diff --git a/src/Development/Shake/AVR.hs b/src/Development/Shake/AVR.hs --- a/src/Development/Shake/AVR.hs +++ b/src/Development/Shake/AVR.hs @@ -4,10 +4,20 @@ , avr_objcopy, avr_objcopy' , avr_objdump, avr_objdump' , avr_size, avr_size' + , avrdude, avrdude' + , AVRDUDE.MemType(..) + , AVRDUDE.Dir(..) + , AVRDUDE.Op(..) + , AVRDUDE.Format(..) + , AVRDUDE.ActionsM + , AVRDUDE.Actions + , AVRDUDE.action + , AVRDUDE.r, AVRDUDE.v, AVRDUDE.w, AVRDUDE.imm ) where import Development.Shake +import qualified System.Command.AVRDUDE as AVRDUDE gccDeps cc cFlags src = do Stdout cppOut <- command [Traced ""] cc (cFlags ++ ["-M", "-MG", "-E", src]) @@ -17,17 +27,17 @@ avr_gcc' cc cFlags src out = do need [src] need =<< gccDeps cc cFlags src - system' cc (cFlags ++ ["-c", src, "-o", out]) + command_ [] cc (cFlags ++ ["-c", src, "-o", out]) avr_ld = avr_ld' "avr-ld" avr_ld' ld ldFlags objs out = do need objs - system' ld (ldFlags ++ ["-o", out] ++ objs) + command_ [] ld (ldFlags ++ ["-o", out] ++ objs) avr_objcopy = avr_objcopy' "avr-objcopy" avr_objcopy' objcopy fmt flags src out = do need [src] - system' objcopy (flags ++ ["-O", fmt, src, out]) + command_ [] objcopy (flags ++ ["-O", fmt, src, out]) avr_objdump = avr_objdump' "avr-objdump" avr_objdump' objdump src out = do @@ -42,7 +52,7 @@ putNormal lss avrdude = avrdude' "avrdude" -avrdude' avrdudeBin mem flags hex port = do +avrdude' avrdudeBin mcu opts actions = do alwaysRerun - need [hex] - system' avrdudeBin (flags ++ ["-P", port, "-U" ++ mem ++ ":w:" ++ hex]) + need (fst (AVRDUDE.actionFiles actions)) + command_ [] avrdudeBin (["-p", mcu] ++ opts ++ AVRDUDE.encodeActions actions) diff --git a/src/System/Command/AVRDUDE.hs b/src/System/Command/AVRDUDE.hs new file mode 100644 --- /dev/null +++ b/src/System/Command/AVRDUDE.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeOperators #-} +module System.Command.AVRDUDE + ( MemType(..) + , Dir(..) + , Op(..) + , Format(..) + , ActionsM + , Actions + , action + , r, v, w, imm + , encodeActions + , actionFiles + , avrdude + ) where + +import Control.Applicative +import Control.Monad.Writer +import Data.GADT.Compare +import Data.List +import Data.Monoid +import Data.Word +import System.Exit +import System.Process +import Text.Printf + +data MemType + = Calibration + | EEPROM + | EFuse + | Flash + | Fuse + | HFuse + | LFuse + | Lock + | Signature + | FuseN !Integer + | Application + | AppTable + | Boot + | ProdSig + | UserSig + | OtherMemType !String + +encodeMemType :: MemType -> String +encodeMemType Calibration = "calibration" +encodeMemType EEPROM = "eeprom" +encodeMemType EFuse = "efuse" +encodeMemType Flash = "flash" +encodeMemType Fuse = "fuse" +encodeMemType HFuse = "hfuse" +encodeMemType LFuse = "lfuse" +encodeMemType Lock = "lock" +encodeMemType Signature = "signature" +encodeMemType (FuseN n) = "fuse" ++ show n +encodeMemType Application = "application" +encodeMemType AppTable = "apptable" +encodeMemType Boot = "boot" +encodeMemType ProdSig = "prodsig" +encodeMemType UserSig = "usersig" +encodeMemType (OtherMemType other) = other + +data Dir = In | Out + +data Op dir where + R :: Op Out + V :: Op Out + W :: Op In + +encodeOp :: Op dir -> Char +encodeOp R = 'r' +encodeOp V = 'v' +encodeOp W = 'w' + +data Format dir t where + IHex :: Format dir FilePath + SRec :: Format dir FilePath + Raw :: Format dir FilePath + Immediate :: Format In [Word8] + Auto :: Format dir FilePath + Dec :: Format Out FilePath + Hex :: Format Out FilePath + Oct :: Format Out FilePath + Bin :: Format Out FilePath + +encodeFormat :: Format dir t -> (Char, Maybe (t := FilePath), t -> String) +encodeFormat IHex = ('i', Just Refl, id) +encodeFormat SRec = ('s', Just Refl, id) +encodeFormat Raw = ('r', Just Refl, id) +encodeFormat Immediate = ('m', Nothing, encodeImmediate) +encodeFormat Auto = ('a', Just Refl, id) +encodeFormat Dec = ('d', Just Refl, id) +encodeFormat Hex = ('h', Just Refl, id) +encodeFormat Oct = ('o', Just Refl, id) +encodeFormat Bin = ('b', Just Refl, id) + +encodeImmediate :: [Word8] -> String +encodeImmediate = intercalate "," . map encodeHex + +-- TODO: see if there's an escape mechanism for strings with colons + +encodeHex :: Word8 -> String +encodeHex = printf "0x%02x" + +data Action where + Action :: MemType -> Op dir -> t -> Format dir t -> Action + +encodeAction :: Action -> String +encodeAction (Action memType op name format) = + intercalate ":" + [ encodeMemType memType + , [encodeOp op] + , encodeName name + , [encodedFormat] + ] + where + (encodedFormat, _, encodeName) = encodeFormat format + +actionFile :: Action -> Maybe FilePath +actionFile (Action _ _ name format) = case encodeFormat format of + (_, Just Refl, _) -> Just name + (_, Nothing, _) -> Nothing + +actionNeedsFile :: Action -> Bool +actionNeedsFile (Action _ W _ _) = True +actionNeedsFile (Action _ V _ _) = True +actionNeedsFile _ = False + +newtype ActionsM t = ActionsM (Writer [Action] t) + deriving (Monad, Functor, Applicative) + +type Actions = ActionsM () + +instance Monoid t => Monoid (ActionsM t) where + mempty = pure mempty + mappend = liftA2 mappend + +runActions :: Actions -> [Action] +runActions (ActionsM x) = execWriter x + +action :: MemType -> Op dir -> t -> Format dir t -> Actions +action memType op name format = ActionsM (tell [Action memType op name format]) + +r :: MemType -> FilePath -> Actions +r memType path = action memType R path Auto + +v :: MemType -> FilePath -> Actions +v memType path = action memType V path Auto + +w :: MemType -> FilePath -> Actions +w memType path = action memType W path Auto + +imm :: MemType -> [Word8] -> Actions +imm memType path = action memType W path Immediate + +encodeActions :: Actions -> [String] +encodeActions = map (("-U" ++) . encodeAction) . runActions + +actionFiles :: Actions -> ([FilePath], [FilePath]) +actionFiles actions = (map snd needed, map snd produced) + where + ~(needed, produced) = partition fst + [ (actionNeedsFile action, file) + | action <- runActions actions + , Just file <- [actionFile action] + ] + +avrdude :: [String] -> Actions -> IO ExitCode +avrdude args actions = rawSystem "avrdude" (args ++ encodeActions actions) +