gcodehs-0.1.2.0: app/Main.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where


import Pipes (Pipe, (>->))
import Pipes.Safe (SafeT)
import Data.ByteString (ByteString)

import Control.Applicative
import Options.Applicative

import Data.GCode
import Data.GCode.Pipes.Transform
import Data.GCode.Line (prettyLine)

data Command =
    Cat
  | Pretty
  | Analyze
  | Totalize
  | TranslateXY Double Double
  | TranslateZ Double
  | Rotate Double
  | ScaleFeedrate Double
  | ScaleXY Double Double
  | Eval
  | Canon
  | Lines
  -- TODO
  | TravelDistance
  | ExtrusionDistance
  | Generate
  -- disabled for now as they require interepreter not just looking at coords
  -- (due to relative moves)
  | Limits
  | ToOrigin
  deriving (Eq, Show, Ord)

data Options = Options {
    cmd     :: Command
  , input   :: FilePath
  , output  :: Maybe FilePath
  } deriving (Show)

cmdParser :: Parser Command
cmdParser = subparser
  (  command "cat" (info (pure Cat) (progDesc "Parse and print GCode"))
  <> command "pretty" (info (pure Pretty) (progDesc "Parse and pretty-print GCode"))
--  <> command "limits" (info (pure Limits) (progDesc "Compute axis movements limits"))
--  <> command "move-to-origin" (info (pure ToOrigin) (progDesc "Move GCode so it starts at X0 Y0"))
  <> command "totalize" (info (pure Totalize) (progDesc "Walk GCode adding missing axes coordinates according to previous moves"))
  <> command "translate-xy" (info (TranslateXY <$> argument auto (metavar "X") <*> argument auto (metavar "Y")) (progDesc "Translate GCode by X Y offsets"))
  <> command "translate-z" (info (TranslateZ <$> argument auto (metavar "Z")) (progDesc "Translate GCode by Z offset"))
  <> command "rotate" (info (Rotate <$> argument auto (metavar "DEG")) (progDesc "Rotate GCode by angle in degrees"))
  <> command "scale-feedrate" (info (ScaleFeedrate <$> argument auto (metavar "MULTIPLIER")) (progDesc "Scale feedrates by multiplier"))
  <> command "scale-xy" (info (ScaleXY <$> argument auto (metavar "X") <*> argument auto (metavar "Y")) (progDesc "Scale X/Y by multiplier"))
  <> command "eval" (info (pure Eval) (progDesc "Evaluate GCode"))
  <> command "canon" (info (pure Canon) (progDesc "Convert to canonical representation"))
  <> command "lines" (info (pure Lines) (progDesc "Convert to lines"))
  )

flags :: Parser Options
flags = Options
    <$> cmdParser
    <*> argument str (metavar "INPUT-FILE")
    <*> (optional
      $ strOption (
             long "output"
          <> short 'o'
          <> metavar "OUTPUT-FILE"))

main :: IO ()
main =
    execParser opts >>= \Options{..} -> runPipe input output (toSink cmd)
    where
      opts = info (helper <*> flags)
        ( fullDesc
       <> progDesc "Process GCode from FILE"
       <> header "gcodehs - GCode processor" )

toSink :: Command -> Pipe Code ByteString (SafeT IO) ()
toSink Cat      = compactSink
toSink Pretty   = prettySink
toSink Totalize = totalizeP >-> compactSink
toSink Eval     = evalP >-> prettySink
toSink Canon    = evalP >-> evalCanonP >-> prettySinkWith (wrapPrinter show)
toSink Lines    = evalP >-> evalCanonLinesP >-> (prettySinkWith $ wrapPrinter $ prettyLine defaultStyle)

toSink (TranslateXY xt yt) = translateXY xt yt >-> compactSink
toSink (TranslateZ  zt)    = translateZ zt     >-> compactSink
toSink (ScaleXY xs ys)     = scaleXY xs ys     >-> compactSink
toSink (ScaleFeedrate s)   = scaleFeedrate s   >-> compactSink
toSink (Rotate a)          = rotate a          >-> compactSink

toSink _ = error "Currently not supported, sorry :("