{-# LANGUAGE OverloadedStrings #-}
module Data.GCode.Parse (parseGCode, parseGCodeLine, parseOnlyGCode) where
import Data.GCode.Types
import Prelude hiding (take, takeWhile, mapM)
import Control.Applicative
import qualified Data.ByteString as B
import Data.Attoparsec.ByteString.Char8
import qualified Data.Map.Strict as M
import Data.Either (lefts, rights)
parseGCodeLine :: Parser Code
parseGCodeLine = between lskip lskip parseCodeParts <* endOfLine
parseGCode :: Parser GCode
parseGCode = many1 parseGCodeLine
parseOnlyGCode :: B.ByteString -> Either String GCode
parseOnlyGCode = parseOnly parseGCode
lskip = skipWhile (\x -> x == ' ' || x == '\t')
between open close p = do{ open; x <- p; close; return x }
isEndOfLineChr :: Char -> Bool
isEndOfLineChr '\n' = True
isEndOfLineChr '\r' = True
isEndOfLineChr _ = False
parseLead = do
a <- satisfy $ (\c -> c == 'G' || c == 'M' || c == 'T' || c == 'P' || c == 'F' || c == 'S')
return $ codecls a
{-# INLINE parseLead #-}
parseAxisDes = do
a <- satisfy $ (\c -> c == 'X' || c == 'Y' || c == 'Z' || c == 'A' || c == 'B' || c == 'C' || c == 'E' || c == 'L')
return $ axis a
{-# INLINE parseAxisDes #-}
parseParamDes = do
a <- satisfy $ inClass "SPF"
return $ param a
{-# INLINE parseParamDes #-}
parseParamOrAxis = do
lskip
ax <- option Nothing (Just <$> parseAxisDes)
case ax of
Just val -> do
lskip
f <- double
return $ Left (val, f)
Nothing -> do
param <- parseParamDes
lskip
f <- double
return $ Right (param, f)
parseAxesParams :: Parser (Axes, Params)
parseAxesParams = do
a <- many parseParamOrAxis
return (M.fromList $ lefts a, M.fromList $ rights a)
{-# INLINE parseAxesParams #-}
parseCode = do
lead <- optional parseLead
gcode <- optional decimal
subcode <- optional (char '.' *> decimal)
lskip
(axes, params) <- parseAxesParams
lskip
comment <- option "" $ between lskip lskip parseComment'
let c = Code lead gcode subcode axes params comment
if c == emptyCode
then return $ Empty
else return c
parseComment' = do
t <- many $ between (lskip *> char '(') (char ')' <* lskip) $ takeWhile1 (/=')')
semisep <- option "" $ char ';' *> takeWhile (not . isEndOfLineChr)
rest <- takeWhile (not . isEndOfLineChr)
return $ B.concat $ t ++ [semisep, rest]
parseComment = Comment <$> parseComment'
parseOther = do
a <- takeWhile (not . isEndOfLineChr)
return $ Other a
parseCodeParts =
parseCode
<|> parseComment
<|> parseOther