Build with stack

1 files changed, 0 insertions, 145 deletions

diff --git a/main.hs b/main.hs
deleted file mode 100644
index b908807..0000000
--- a/main.hs
+++ /dev/null
@@ -1,145 +0,0 @@
-module Main where
-
-import Control.Monad
-import Data.Char
-import Data.List
-import Data.Either
-import Data.Maybe
-import System.Console.Readline
-import System.Exit
-import System.IO
-import qualified Data.Map.Strict as Map
-
-import AST hiding (main)
-import Simplify
-import Parser
-import PrettyPrint
-import Utility
-import Debug
-
-
-trimlr :: String -> String
-trimlr = reverse . dropWhile isSpace . reverse . dropWhile isSpace
-
-findstr :: String -> String -> Maybe Int
-findstr pat sub = go sub 0
-    where len = length pat
-          go :: String -> Int -> Maybe Int
-          go "" _ = Nothing
-          go sub i = if take len sub == pat then Just i else go (tail sub) (i+1)
-
-mayberead :: Read a => String -> Maybe a
-mayberead s =
-    let r = reads s
-        ok = if null r then False else null $ snd $ head r
-        v = fst $ head r
-    in if ok then Just v else Nothing
-
-readrule :: String -> IO (AST,AST)
-readrule line = do
-    let (patstr',(repstr')) = break (=='|') line
-        patstr = desugar $ trimlr patstr'
-        repstr = desugar $ trimlr $ tail repstr'
-    if null repstr'
-    then die $ "No pipe separator found: " ++ line
-    else do
-        let mpat = mayberead patstr :: Maybe AST
-            mrep = mayberead repstr :: Maybe AST
-        when (isNothing mpat) $ die $ "Could not parse pattern! (from '" ++ patstr ++ "')"
-        when (isNothing mrep) $ die $ "Could not parse replacement! (from '" ++ repstr ++ "')"
-        return (fromJust mpat,fromJust mrep)
-
-desugar :: String -> String
-desugar "" = ""
-desugar ('{':cs) =
-    let midx = findIndex (=='}') cs
-        idx = fromJust midx
-        termcap = head cs == '{' && length cs > idx+1 && cs !! (idx+1) == '}'
-        endidx = if termcap then idx+1 else idx
-        after = drop (endidx+1) cs
-        name' = if termcap then tail $ take (endidx-1) cs else take endidx cs
-        name = map (\c -> if c == '\\' || c == '"' then '_' else c) name'
-    in if isNothing midx
-       then '{':desugar cs
-       else if termcap
-            then let mcolonidx = findIndex (==':') name
-                     colonidx = fromJust mcolonidx
-                     precolon = take colonidx name
-                     postcolon = drop (colonidx+1) name
-                     stub = case postcolon of
-                         "Number" -> "Number 42"
-                         "Variable" -> "Variable \"\""
-                         _ -> trace postcolon undefined
-                 in if isNothing mcolonidx
-                    then "(CaptureTerm \"" ++ name ++ "\")" ++ desugar after
-                    else "(CaptureConstr \"" ++ precolon ++ "\" (" ++ stub ++ "))" ++ desugar after
-            else "(Capture \"" ++ name ++ "\")" ++ desugar after
-desugar (':':cs) =
-    let midx = findIndex (==':') cs
-        endidx = fromJust midx
-        after = drop (endidx+1) cs
-        name = map (\c -> if c == '\\' || c == '"' then '_' else c) $ take endidx cs
-    in if isNothing midx
-       then ':':desugar cs
-       else "Apply \"" ++ name ++ "\" " ++ desugar after
-desugar (c:cs) = c : desugar cs
-
-readrules :: Handle -> IO (Map.Map String [(AST,AST)])
-readrules handle = liftM (uncurry fixincludes) $ go "general" Map.empty Map.empty
-  where
-    go :: String  -- current section
-       -> Map.Map String [String]  -- sections still to be included (#+)
-       -> Map.Map String [(AST,AST)]  -- current rules db
-       -> IO (Map.Map String [(AST,AST)],Map.Map String [String])  -- (rules db,includes)
-    go sect includes db = hIsEOF handle >>= \eof -> if eof then return (db,includes) else do
-        line <- hGetLine handle
-        case take 3 line of
-            "" -> go sect includes db
-            "-- " -> go sect includes db
-            "## " -> go (trimlr $ drop 3 line) includes db
-            "#+ " -> go sect (Map.insertWith (++) sect [trimlr $ drop 3 line] includes) db
-            _ -> readrule (trimlr line) >>= \rule -> go sect includes (Map.insertWith (flip (++)) sect [rule] db)
-
-    fixincludes :: Map.Map String [(AST,AST)]  -- rules db
-                -> Map.Map String [String]  -- to be included sections
-                -> Map.Map String [(AST,AST)]  -- resulting rules db
-    fixincludes db includes = Map.foldlWithKey insertincludes db includes
-      where
-        insertincludes :: Map.Map String [(AST,AST)]  -- db
-                      -> String  -- section
-                      -> [String]  -- sections to be included
-                      -> Map.Map String [(AST,AST)]  -- resulting db
-        insertincludes db sect incls = foldl (\db incl -> insertinclude db sect incl) db incls
-            where insertinclude db sect incl = Map.insertWith (++) sect (fromJust $ Map.lookup incl db) db
-
-
-printrules :: [(AST,AST)] -> IO ()
-printrules db = sequence_ $ foldl (\l (pat,sub) -> l ++ [print pat,putStr " -> ",print sub]) [] db
-
-
-repl :: Map.Map String [(AST,AST)] -> IO ()
-repl db = do
-    mline <- readline "> "
-    case mline of
-        Nothing -> return ()  -- EOF
-        Just "" -> repl db
-        Just line -> do
-            addHistory line
-            let eexpr = parseExpression line
-            either (putStrLn . ("Error: "++)) handleExpression eexpr
-            repl db
-    where
-        generaldb = fromJust $ Map.lookup "general" db
-        sanitisedb = fromJust $ Map.lookup "sanitise" db
-        displaydb = fromJust $ Map.lookup "display" db
-        handleExpression expr = do
-            putStrLn $ prettyPrint expr
-            let sim = foldl (flip simplify) expr [generaldb,sanitisedb,displaydb]
-            putStrLn $ prettyPrint sim
-
-
-main :: IO ()
-main = do
-    rulesdb <- withFile "rules.txt" ReadMode readrules
-    --sequence_ $ Map.foldlWithKey (\l sect rules -> putStrLn ("## "++sect) : printrules rules : putStrLn "" : l) [] rulesdb
-    repl rulesdb