carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-11-04 01:25:04 +03:00
Code Issues Projects Releases Wiki Activity

Removed 'sed' support, allow --kebabcase flag, and -p which can remove

Browse Source 
a prefix from each function.
This commit is contained in:
Erik Svedäng 2018-02-27 15:57:00 +01:00
parent c4a0f51e09
commit 20d63ff7dc
1 changed files with 37 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
headerparse/Main.hs
View File

@ -9,26 +9,31 @@ import System.IO.Unsafe (unsafePerformIO)
import System.Process
import Text.Parsec ((<|>))
import qualified Text.Parsec as Parsec
import Data.Char (toLower, isUpper)
import Util
import Types
import Obj
data Args = Args { sourcePath :: String
, sedCommand :: String
, prefixToRemove :: String
, kebabCase :: Bool
} deriving (Show, Data, Typeable)
main = do parsedArgs <- cmdArgs (Args { sourcePath = def &= argPos 0
, sedCommand = def
, prefixToRemove = def
, kebabCase = False
}
&= summary "Carp Header Parse 0.0.1")
let path = sourcePath parsedArgs
if path /= ""
then do source <- readFile path
putStrLn (joinWith "\n" (map pretty (parseHeaderFile path source (sedCommand parsedArgs))))
putStrLn (joinWith "\n" (map pretty (parseHeaderFile path source
(prefixToRemove parsedArgs)
(kebabCase parsedArgs))))
else print parsedArgs
parseHeaderFile :: FilePath -> String -> String -> [XObj]
parseHeaderFile path src sedCommand =
parseHeaderFile :: FilePath -> String -> String -> Bool -> [XObj]
parseHeaderFile path src prefix kebab =
case Parsec.runParser cSyntax () path src of
Left err -> error (show err)
Right ok -> concat ok
@ -60,10 +65,17 @@ parseHeaderFile path src sedCommand =
Parsec.many spaceOrTab
Parsec.char ';'
Parsec.many spaceOrTab
let carpName =
(if kebab then (toKebab . lowerFirst) else id)
(if prefix == "" then name else removePrefix prefix name)
emitName = name
return [XObj (Lst ([ (XObj (Sym (SymPath [] "register") Symbol) Nothing Nothing)
, (XObj (Sym (SymPath [] name) Symbol) Nothing Nothing)
, (XObj (Sym (SymPath [] carpName) Symbol) Nothing Nothing)
, toTypeXObj argTypeStrings (returnTypeString, length stars1 + length stars2)
] ++ (optionalSedCommand sedCommand name)
] ++
if prefix == ""
then []
else [(XObj (Str emitName) Nothing Nothing)]
)) Nothing Nothing]
arg :: Parsec.Parsec String () (String, Int)
@ -81,9 +93,6 @@ parseHeaderFile path src sedCommand =
stars :: Parsec.Parsec String () String
stars = Parsec.many (Parsec.char '*')
identifierChar :: Parsec.Parsec String () Char
identifierChar = Parsec.choice [Parsec.letter, Parsec.digit, Parsec.char '_']
spaceOrTab :: Parsec.Parsec String () Char
spaceOrTab = Parsec.choice [Parsec.char ' ', Parsec.char '\t']
@ -110,12 +119,21 @@ cTypeToCarpType ("void", 0) = UnitTy
cTypeToCarpType (s, 0) = (StructTy s [])
cTypeToCarpType (x, stars) = (PointerTy (cTypeToCarpType (x, stars - 1)))
optionalSedCommand :: String -> String -> [XObj]
optionalSedCommand "" _ = []
optionalSedCommand sedCommand name =
let newName = unsafePerformIO $ do (_, Just ho1, _, hp1) <- createProcess (shell ("echo " ++ name ++ " | sed " ++ show sedCommand))
{std_out = CreatePipe}
sOut <- hGetContents ho1
_ <- waitForProcess hp1
return sOut
in [(XObj (Str (init newName)) Nothing Nothing)]
identifierChar :: Parsec.Parsec String () Char
identifierChar = Parsec.choice [Parsec.letter, Parsec.digit, Parsec.char '_']
removePrefix :: String -> String -> String
removePrefix prefix s =
case Parsec.runParser match () "" s of
Left err -> s
Right ok -> ok
where match =
do _ <- Parsec.string prefix
Parsec.many1 identifierChar
lowerFirst :: String -> String
lowerFirst (c : cs) = toLower c : cs
toKebab :: String -> String
toKebab [] = []
toKebab (c : cs) = (if isUpper c then ['-', toLower c] else [c]) ++ toKebab cs