{-# LANGUAGE CPP, TemplateHaskell #-}
module MagicHaskeller.ExpToHtml(QueryOptions(..), defaultQO,
review,
expToPlainString, expSigToString, refer, pprnn, annotateFree, annotateString, Language(..)) where
import Language.Haskell.TH as TH
import Language.Haskell.TH.PprLib(to_HPJ_Doc)
import Text.PrettyPrint
import Network.URI(escapeURIString, isUnreserved)
import Text.Html(stringToHtmlString)
import MagicHaskeller.LibTH(fromPrelude, fromDataList, fromDataChar, fromDataMaybe, Primitive, ords, prelOrdRelated, prelEqRelated, dataListOrdRelated, dataListEqRelated, fromPrelDouble, fromPrelRatio, fromDataRatio)
import Data.Char(isAlpha, ord, isDigit, isSpace, toUpper)
import qualified Data.Map
import qualified Data.IntSet as IS
import Data.Generics
import MagicHaskeller.CoreLang(stripByd_)
import Data.Hashable
import Data.List((\\))
import Control.Monad(mplus)
-- Maybe QueryOptions should be put in a new module.
data QueryOptions = Q {depth :: Int, absents :: Bool} deriving (Read, Show)
defaultQO = Q {depth = 7, absents = False}
data Language = LHaskell | LExcel | LJavaScript deriving (Read, Show, Eq)
-- | 'review' makes sure the predicate string does not use either let or where, and may correct grammatical mistakes.
-- This check should be done on both the CGI frontend side and the backend server side.
-- (But actually is done only on the CGI side.)
review :: String -> Either String (String,Bool)
review "" = return ("",False)
review xs = case lex xs of
[] | '"':_ <- dropWhile isSpace xs -> Left "
Lex error: maybe double-quotes are not balanced. " -- Unbalanced double-quotes may be automatically closed at the end, but that can be confusing.
| otherwise -> Left "