module SaveProdRules where
import Data.Hashable
import System.IO
import System.Directory
import CFG
saveProdRules :: String -> String -> [String] -> IO Bool
saveProdRules fileName startSymbol prodRuleStrs = do
writeOnceWithHash fileName grmStrLn
where
grmStr = toCFG startSymbol prodRuleStrs
grmStrLn = grmStr ++ "\n"
toCFG :: String -> [String] -> String
toCFG startSymbol prodRuleStrs =
"CFG " ++ show startSymbol ++
" [\n" ++ concatWith (toProdRules prodRuleStrs) ",\n" ++ "\n ]"
toProdRules :: [String] -> [String]
toProdRules productionRuleStrs = map (toProdRule lhsStrs) lhsRhsStrss
where
lhsStrs = map head lhsRhsStrss
lhsRhsStrss = map tokenizeLhs productionRuleStrs
toProdRule :: [String] -> [String] -> String
toProdRule lhsStrs (lhs:rhsStrs) =
" ProductionRule " ++ show lhs ++
" [" ++ concatWith (map (toSymbol lhsStrs) rhsStrs) ", " ++ "]"
toSymbol :: [String] -> String -> String
toSymbol lhsStrs sym
| sym `elem` lhsStrs = "Nonterminal " ++ show sym
| otherwise = "Terminal " ++ show sym
tokenizeLhs :: String -> [String]
tokenizeLhs str =
case lex str of
[] -> error "No lhs found (1)"
[("",therest)] -> error "No lhs found (2)"
[(lhs,therest)] -> lhs : tokenizeArrow therest
tokenizeArrow :: String -> [String]
tokenizeArrow str =
case lex str of
[] -> error "No arrow found (1)"
[("",therest)] -> error "No arrow found (2)"
[(arrow@"->",therest)] -> tokenizeRhs therest
[(token,therest)] -> error ("No arrow found: " ++ token)
tokenizeRhs :: String -> [String]
tokenizeRhs str =
case lex str of
[] -> []
[("",therest)] -> []
[(token,therest)] -> token : tokenizeRhs therest
concatWith :: [String] -> String -> String
concatWith [] sep = ""
concatWith [a] sep = a
concatWith (a:b:theRest) sep = a ++ sep ++ concatWith (b:theRest) sep
getHashFileName fileName = fileName ++ ".hash"
writeOnceWithHash :: String -> String -> IO Bool
writeOnceWithHash fileName text = do
let hashFileName = getHashFileName fileName
let newHash = hash text
fileExists <- doesFileExist fileName
hashExists <- doesFileExist hashFileName
case fileExists && hashExists of
False -> do
writeFile fileName text
writeFile hashFileName (show newHash)
return True
True -> do
existingHashStr <- readFile hashFileName
case newHash == (read existingHashStr :: Int) of
True -> return False
False -> do
writeFile fileName text
writeFile hashFileName (show newHash)
return True