elm-repl-0.2.1: src/Environment.hs

{-# LANGUAGE OverloadedStrings #-}
module Environment where

import Data.ByteString (ByteString)
import Data.Monoid     ((<>))
import qualified Data.ByteString.Char8 as BS
-- | TODO: Switch to a Char-based trie.
import Data.Trie       (Trie)
import qualified Data.Trie             as Trie

import Action (Term, Def(..))

data Repl = Repl
    { compilerPath :: FilePath
    , flags :: [String]
    , imports :: Trie String
    , adts :: Trie String
    , defs :: Trie String
    } deriving Show

empty :: FilePath -> Repl
empty compilerPath =
    Repl compilerPath [] Trie.empty Trie.empty (Trie.singleton firstVar (BS.unpack firstVar <> " = ()"))

firstVar :: ByteString
firstVar = "tsol"

lastVar :: ByteString
lastVar = "deltron3030"

toElm :: Repl -> String
toElm env = unlines $ "module Repl where" : decls
    where decls = concatMap Trie.elems [ imports env, adts env, defs env ]

insert :: Term -> Repl -> Repl
insert (src, def) env = case def of
  Nothing -> display src env
  Just (Import mport) -> noDisplay $ env { imports = Trie.insert (BS.pack mport) src (imports env) }
  Just (DataDef def)  -> noDisplay $ env { adts    = Trie.insert (BS.pack def)   src (adts env) }
  Just (VarDef var)   -> define (BS.pack var) src . display var $ env

define :: ByteString -> String -> Repl -> Repl
define name body env = env { defs = Trie.insert name body (defs env) }

display :: String -> Repl -> Repl
display = define lastVar . format
  where format body = (BS.unpack lastVar) ++ " =" ++ concatMap ("\n  "++) (lines body)

noDisplay :: Repl -> Repl
noDisplay env = env { defs = Trie.delete lastVar (defs env) }