parse_script.hs

-- ルーチン同士の呼び出し関係を解析するコード
--  * Parsecを使う
--  * ファイルinを読み込んで行ごとに分解して表示
--  * 表示するのはcallの行のみ
--  * showを一部実装


-- 同じフォルダにApplicativeParsec.hsを用意する
import ApplicativeParsec
import Data.Maybe
import Data.List

type RoutineName = String

data Line_ = CallLine { name_ :: RoutineName } | OtherLine deriving Eq

instance Show Line_ where
  show a = case a of
             CallLine x -> "call " ++ x
             _ -> "otherline"

isCallLine :: Line_ -> Bool
isCallLine a = case a of
                 CallLine x -> True
                 _ -> False

isOtherLine :: Line_ -> Bool
isOtherLine a = case a of
                 CallLine x -> False
                 _ -> True

getRoutineName :: Line_ -> Maybe RoutineName
getRoutineName x = case x of
        CallLine s -> Just s
        OtherLine -> Nothing

filterCallLine :: Routine -> Routine
filterCallLine r = Routine (name r) $ (filter isCallLine $ lines_ r)

data Routine = Routine{ name :: RoutineName, lines_ :: [Line_]} deriving Eq

instance Show Routine where
  show r = case r of
             Routine n ls -> n ++ "\n" ++ (concat $ intersperse "\n" (map show $ lines_ r))

m_call_line :: CharParser () Line_
m_call_line = CallLine <$> ( string "call" *> spaces *> many1 (noneOf ";\r\n{}"))
  <?> "m_call_line"

m_not_call_line :: CharParser () Line_
m_not_call_line = OtherLine <$ many1( noneOf ";\n\r{}" ) <?> "m_not_call_line"

m_line :: CharParser () Line_
m_line = spaces_ *> ( try(m_call_line) <|> m_not_call_line ) <* spaces_
  <?> "m_line"

m_lines :: CharParser () [Line_]
--m_lines = many ( try(m_call_line) <|> m_not_call_line )
m_lines = m_line `endBy` (string ";" *> spaces_) <?> "m_lines"

spaces_ :: CharParser () String
spaces_ = many( oneOf " \t\r\n" ) <?> "spaces"

m_routine :: CharParser () Routine
m_routine = Routine 
  <$> (many1 letter <* string ":" <* spaces_ )<*> ( between (string "{" <* spaces_) ( spaces_ *> string "}" ) m_lines) -- [Line_]
  <?> "m_routine"

m_file :: CharParser () [Routine]
m_file = many1 (spaces_ *> m_routine <* spaces_) <?> "m_file"

--crlf :: Parser

main = do
  cs <- readFile "in"
  case parse m_file "(stdin)" cs of
       Left e -> do putStrLn "Error parsing input:"
                    print e
       Right r -> print $ map filterCallLine r