module SaveProdRules where

import Data.Hashable
import System.IO
import System.Directory
import CFG

saveProdRules :: String -> String -> [String] -> IO Bool
saveProdRules :: String -> String -> [String] -> IO Bool
saveProdRules String
fileName String
startSymbol [String]
prodRuleStrs = do
  String -> String -> IO Bool
writeOnceWithHash String
fileName String
grmStrLn
  where
    grmStr :: String
grmStr   = String -> [String] -> String
toCFG String
startSymbol [String]
prodRuleStrs
    grmStrLn :: String
grmStrLn = String
grmStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

toCFG :: String -> [String] -> String {- CFG -}
toCFG :: String -> [String] -> String
toCFG String
startSymbol [String]
prodRuleStrs =
  String
"CFG " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
startSymbol String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
" [\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String -> String
concatWith ([String] -> [String]
toProdRules [String]
prodRuleStrs) String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n ]"

toProdRules :: [String] -> [String] {- [ProductionRule] -}
toProdRules :: [String] -> [String]
toProdRules [String]
productionRuleStrs = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [String] -> String
toProdRule [String]
lhsStrs) [[String]]
lhsRhsStrss
  where
    lhsStrs :: [String]
lhsStrs     = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall a. [a] -> a
head [[String]]
lhsRhsStrss
    lhsRhsStrss :: [[String]]
lhsRhsStrss = (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
tokenizeLhs [String]
productionRuleStrs
    
toProdRule :: [String] -> [String] -> String {- ProductionRule -}
toProdRule :: [String] -> [String] -> String
toProdRule [String]
lhsStrs (String
lhs:[String]
rhsStrs) =
  String
" ProductionRule " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
lhs String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String -> String
concatWith ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String -> String
toSymbol [String]
lhsStrs) [String]
rhsStrs) String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

toSymbol :: [String] -> String -> String {- Symbol -}
toSymbol :: [String] -> String -> String
toSymbol [String]
lhsStrs String
sym
  | String
sym String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
lhsStrs = String
"Nonterminal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
sym
  | Bool
otherwise          = String
"Terminal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
sym

-- Parse production rules
tokenizeLhs :: String -> [String]
tokenizeLhs :: String -> [String]
tokenizeLhs String
str =
  case ReadS String
lex String
str of
    []              -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No lhs found (1)"
    [(String
"",String
therest)]  -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No lhs found (2)" 
    [(String
lhs,String
therest)] -> String
lhs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
tokenizeArrow String
therest

tokenizeArrow :: String -> [String]
tokenizeArrow :: String -> [String]
tokenizeArrow String
str =
  case ReadS String
lex String
str of
    []                     -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No arrow found (1)"
    [(String
"",String
therest)]         -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No arrow found (2)" 
    [(arrow :: String
arrow@String
"->",String
therest)] -> String -> [String]
tokenizeRhs String
therest
    [(String
token,String
therest)]      -> String -> [String]
forall a. HasCallStack => String -> a
error (String
"No arrow found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
token)
    
tokenizeRhs :: String  -> [String]
tokenizeRhs :: String -> [String]
tokenizeRhs String
str = 
  case ReadS String
lex String
str of
    []                -> []
    [(String
"",String
therest)]    -> []
    [(String
token,String
therest)] -> String
token String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
tokenizeRhs String
therest

-- Utility
concatWith :: [String] -> String -> String
concatWith :: [String] -> String -> String
concatWith [] String
sep = String
""
concatWith [String
a] String
sep = String
a
concatWith (String
a:String
b:[String]
theRest) String
sep = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String -> String
concatWith (String
bString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
theRest) String
sep

getHashFileName :: String -> String
getHashFileName String
fileName = String
fileName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".hash"

writeOnceWithHash :: String -> String -> IO Bool
writeOnceWithHash :: String -> String -> IO Bool
writeOnceWithHash String
fileName String
text = do
  let hashFileName :: String
hashFileName = String -> String
getHashFileName String
fileName
  let newHash :: Int
newHash = String -> Int
forall a. Hashable a => a -> Int
hash String
text
  
  Bool
fileExists <- String -> IO Bool
doesFileExist String
fileName
  Bool
hashExists <- String -> IO Bool
doesFileExist String
hashFileName

  case Bool
fileExists Bool -> Bool -> Bool
&& Bool
hashExists of
    Bool
False -> do
      String -> String -> IO ()
writeFile String
fileName String
text
      String -> String -> IO ()
writeFile String
hashFileName (Int -> String
forall a. Show a => a -> String
show Int
newHash)
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    Bool
True  -> do
      String
existingHashStr <- String -> IO String
readFile String
hashFileName
      
      case Int
newHash Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Int
forall a. Read a => String -> a
read String
existingHashStr :: Int) of
        Bool
True -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Bool
False -> do
          String -> String -> IO ()
writeFile String
fileName String
text
          String -> String -> IO ()
writeFile String
hashFileName (Int -> String
forall a. Show a => a -> String
show Int
newHash)
          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True