{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
module Lambdabot.Config.Haskell
    ( evalPrefixes
    , languageExts
    , trustedPackages
    
    , djinnBinary
    , ghcBinary
    , ghciBinary
    , hoogleBinary
    , muevalBinary

    , maxPasteLength
    ) where

import Lambdabot.Config

config "evalPrefixes"       [t| [String]                |] [| [">"]         |]

trustedPkgs :: [String]
trustedPkgs :: [String]
trustedPkgs =
    [ String
"array"
    , String
"base"
    , String
"bytestring"
    , String
"containers"
    , String
"lambdabot-trusted"
    , String
"random"
    ]

configWithMerge [| (++) |] "trustedPackages"    [t| [String] |] [| trustedPkgs   |]

-- extensions to enable for the interpreted expression
-- (and probably also L.hs if it doesn't already have these set)
defaultExts :: [String]
defaultExts :: [String]
defaultExts =
    [ String
"ImplicitPrelude" -- workaround for bug in hint package
    , String
"ExtendedDefaultRules"
    ]

configWithMerge [| (++) |] "languageExts"   [t| [String] |] [| defaultExts |]


config "djinnBinary"        [t| String                  |] [| "djinn"       |]
config "ghcBinary"          [t| String                  |] [| "ghc"         |]
config "ghciBinary"         [t| String                  |] [| "ghci"        |]
config "hoogleBinary"       [t| String                  |] [| "hoogle"      |]
config "muevalBinary"       [t| String                  |] [| "mueval"      |]

config "maxPasteLength"     [t| Int                     |] [| 4096 :: Int   |]