-- | Command Line Configuration Options ----------------------------------------

{-# LANGUAGE DeriveDataTypeable         #-}
# LANGUAGE DeriveGeneric #

module Language.Haskell.Liquid.UX.Config (
     Config (..)
   , HasConfig (..)
   , allowPLE, allowLocalPLE, allowGlobalPLE
   , patternFlag
   , higherOrderFlag
   , pruneFlag
   , maxCaseExpand
   , exactDCFlag
   , hasOpt
   , totalityCheck
   , terminationCheck
   , structuralTerm
   ) where

import Prelude hiding (error)
import Language.Fixpoint.Types.Config hiding (Config)
import GHC.Generics
import System.Console.CmdArgs

-- NOTE: adding strictness annotations breaks the help message
data Config = Config
  { loggingVerbosity         :: Verbosity  -- ^ the logging verbosity to use (defaults to 'Quiet')
  , files                    :: [FilePath] -- ^ source files to check
  , idirs                    :: [FilePath] -- ^ path to directory for including specs
  , diffcheck                :: Bool       -- ^ check subset of binders modified (+ dependencies) since last check
  , linear                   :: Bool       -- ^ uninterpreted integer multiplication and division
  , stringTheory             :: Bool       -- ^ interpretation of string theory in the logic
  , higherorder              :: Bool       -- ^ allow higher order binders into the logic
  , higherorderqs            :: Bool       -- ^ allow higher order qualifiers
  , smtTimeout               :: Maybe Int  -- ^ smt timeout
  , fullcheck                :: Bool       -- ^ check all binders (overrides diffcheck)
  , saveQuery                :: Bool       -- ^ save fixpoint query
  , checks                   :: [String]   -- ^ set of binders to check
  , noCheckUnknown           :: Bool       -- ^ whether to complain about specifications for unexported and unused values
  , notermination            :: Bool       -- ^ disable termination check
  , nopositivity             :: Bool       -- ^ disable positivity check
  ^ Adds precise reasoning on presence of rankNTypes
  , noclasscheck             :: Bool       -- ^ disable checking class instances
  -- , structuralTerm        :: Bool       -- ^ use structural termination checker
  , nostructuralterm         :: Bool       -- ^ disable structural termination check
  , gradual                  :: Bool       -- ^ enable gradual type checking
  , bscope                   :: Bool       -- ^ scope of the outer binders on the inner refinements
  , gdepth                   :: Int        -- ^ depth of gradual concretization
  , ginteractive             :: Bool       -- ^ interactive gradual solving
  , totalHaskell             :: Bool       -- ^ Check for termination and totality, Overrides no-termination flags
  , nowarnings               :: Bool       -- ^ disable warnings output (only show errors)
  , noannotations            :: Bool       -- ^ disable creation of intermediate annotation files
  ^ check internal ( GHC - derived ) binders
  , caseExpandDepth          :: Int        -- ^ maximum case expand nesting depth.
  , notruetypes              :: Bool       -- ^ disable truing top level types
  , nototality               :: Bool       -- ^ disable totality check in definitions
  , pruneUnsorted            :: Bool       -- ^ enable prunning unsorted Refinements
  , cores                    :: Maybe Int  -- ^ number of cores used to solve constraints
  , minPartSize              :: Int        -- ^ Minimum size of a partition
  , maxPartSize              :: Int        -- ^ Maximum size of a partition. Overrides minPartSize
  , maxParams                :: Int        -- ^ the maximum number of parameters to accept when mining qualifiers
  ^ name of smtsolver to use [ default : try z3 , cvc4 , mathsat in order ]
  , shortNames               :: Bool       -- ^ drop module qualifers from pretty-printed names.
  , shortErrors              :: Bool       -- ^ don't show subtyping errors and contexts.
  , cabalDir                 :: Bool       -- ^ find and use .cabal file to include paths to sources for imported modules
  ^ command - line options to pass to GHC
  ^ .c files to compile and link against ( for GHC )
  ^ eliminate ( i.e. do n't use  for ) for " none " , " cuts " or " all " kvars
  , port                     :: Int        -- ^ port at which lhi should listen
  , exactDC                  :: Bool       -- ^ Automatically generate singleton types for data constructors
  , noADT                    :: Bool       -- ^ Disable ADTs (only used with exactDC)
  ^ expect failure from Liquid with at least one of the following messages
  , expectAnyError           :: Bool       -- ^ expect failure from Liquid with any message
  , scrapeImports            :: Bool       -- ^ scrape qualifiers from imported specifications
  , scrapeInternals          :: Bool       -- ^ scrape qualifiers from auto specifications
  , scrapeUsedImports        :: Bool       -- ^ scrape qualifiers from used, imported specifications
  , elimStats                :: Bool       -- ^ print eliminate stats
  ^ eliminate upto given depth of KVar chains
  , json                     :: Bool       -- ^ print results (safe/errors) as JSON
  , counterExamples          :: Bool       -- ^ attempt to generate counter-examples to type errors
  , timeBinds                :: Bool       -- ^ check and time each (asserted) type-sig separately
  ^ treat code patterns ( e.g. e1 > > = \x - > e2 ) specially for inference
  , untidyCore               :: Bool       -- ^ print full blown core (with untidy names) in verbose mode
  ^ simplify GHC core before constraint - generation
  PLE - OPT , autoInst       ntiate : : Instantiate -- ^ How to instantiate axioms
  ^ Disable non - concrete KVar slicing
  , noLiftedImport           :: Bool       -- ^ Disable loading lifted specifications (for "legacy" libs)
  , proofLogicEval           :: Bool       -- ^ Enable proof-by-logical-evaluation
  ^ Unfold invocations with undecided guards in PLE
  , oldPLE                   :: Bool       -- ^ Enable proof-by-logical-evaluation
  ^ Use an interpreter to assist PLE
  , proofLogicEvalLocal      :: Bool       -- ^ Enable proof-by-logical-evaluation locally, per function
  , extensionality           :: Bool       -- ^ Enable extensional interpretation of function equality
  , nopolyinfer              :: Bool       -- ^ No inference of polymorphic type application.
  , reflection               :: Bool       -- ^ Allow "reflection"; switches on "--higherorder" and "--exactdc"
  , compileSpec              :: Bool       -- ^ Only "compile" the spec -- into .bspec file -- don't do any checking.
  , noCheckImports           :: Bool       -- ^ Do not check the transitive imports
  ^ enable  support .
  , auxInline                :: Bool        -- ^ 
  , rwTerminationCheck       :: Bool       -- ^ Enable termination checking for rewriting
  , skipModule               :: Bool       -- ^ Skip this module entirely (don't even compile any specs in it)
  , noLazyPLE                :: Bool
  , fuel                     :: Maybe Int  -- ^ Maximum PLE "fuel" (unfold depth) (default=infinite) 
  , environmentReduction     :: Bool       -- ^ Perform environment reduction
  , noEnvironmentReduction   :: Bool       -- ^ Don't perform environment reduction
  ^ Inline ANF bindings .
                                           -- Sometimes improves performance and sometimes worsens it.
  , pandocHtml               :: Bool       -- ^ Use pandoc to generate html
  } deriving (Generic, Data, Typeable, Show, Eq)

allowPLE :: Config -> Bool
allowPLE cfg
  =  allowGlobalPLE cfg
  || allowLocalPLE cfg

allowGlobalPLE :: Config -> Bool
allowGlobalPLE cfg = proofLogicEval  cfg

allowLocalPLE :: Config -> Bool
allowLocalPLE cfg = proofLogicEvalLocal  cfg

instance HasConfig  Config where
  getConfig x = x

class HasConfig t where
  getConfig :: t -> Config

patternFlag :: (HasConfig t) => t -> Bool
patternFlag = not . noPatternInline . getConfig

higherOrderFlag :: (HasConfig t) => t -> Bool
higherOrderFlag x = higherorder cfg || reflection cfg
  where
    cfg           = getConfig x

exactDCFlag :: (HasConfig t) => t -> Bool
exactDCFlag x = exactDC cfg || reflection cfg
  where
    cfg       = getConfig x

pruneFlag :: (HasConfig t) => t -> Bool
pruneFlag = pruneUnsorted . getConfig

maxCaseExpand :: (HasConfig t) => t -> Int
maxCaseExpand = caseExpandDepth . getConfig

hasOpt :: (HasConfig t) => t -> (Config -> Bool) -> Bool
hasOpt t f = f (getConfig t)

totalityCheck :: (HasConfig t) => t -> Bool
totalityCheck = totalityCheck' . getConfig

terminationCheck :: (HasConfig t) => t -> Bool
terminationCheck = terminationCheck' . getConfig

totalityCheck' :: Config -> Bool
totalityCheck' cfg = not (nototality cfg) || totalHaskell cfg

terminationCheck' :: Config -> Bool
terminationCheck' cfg = totalHaskell cfg || not (notermination cfg)

structuralTerm :: (HasConfig a) => a -> Bool
structuralTerm = not . nostructuralterm . getConfig

 | Command Line Configuration Options ----------------------------------------
# LANGUAGE DeriveDataTypeable         #
 NOTE: adding strictness annotations breaks the help message
 ^ the logging verbosity to use (defaults to 'Quiet')
 ^ source files to check
 ^ path to directory for including specs
 ^ check subset of binders modified (+ dependencies) since last check
 ^ uninterpreted integer multiplication and division
 ^ interpretation of string theory in the logic
 ^ allow higher order binders into the logic
 ^ allow higher order qualifiers
 ^ smt timeout
 ^ check all binders (overrides diffcheck)
 ^ save fixpoint query
 ^ set of binders to check
 ^ whether to complain about specifications for unexported and unused values
 ^ disable termination check
 ^ disable positivity check
 ^ disable checking class instances
 , structuralTerm        :: Bool       -- ^ use structural termination checker
 ^ disable structural termination check
 ^ enable gradual type checking
 ^ scope of the outer binders on the inner refinements
 ^ depth of gradual concretization
 ^ interactive gradual solving
 ^ Check for termination and totality, Overrides no-termination flags
 ^ disable warnings output (only show errors)
 ^ disable creation of intermediate annotation files
 ^ maximum case expand nesting depth.
 ^ disable truing top level types
 ^ disable totality check in definitions
 ^ enable prunning unsorted Refinements
 ^ number of cores used to solve constraints
 ^ Minimum size of a partition
 ^ Maximum size of a partition. Overrides minPartSize
 ^ the maximum number of parameters to accept when mining qualifiers
 ^ drop module qualifers from pretty-printed names.
 ^ don't show subtyping errors and contexts.
 ^ find and use .cabal file to include paths to sources for imported modules
 ^ port at which lhi should listen
 ^ Automatically generate singleton types for data constructors
 ^ Disable ADTs (only used with exactDC)
 ^ expect failure from Liquid with any message
 ^ scrape qualifiers from imported specifications
 ^ scrape qualifiers from auto specifications
 ^ scrape qualifiers from used, imported specifications
 ^ print eliminate stats
 ^ print results (safe/errors) as JSON
 ^ attempt to generate counter-examples to type errors
 ^ check and time each (asserted) type-sig separately
 ^ print full blown core (with untidy names) in verbose mode
 ^ How to instantiate axioms
 ^ Disable loading lifted specifications (for "legacy" libs)
 ^ Enable proof-by-logical-evaluation
 ^ Enable proof-by-logical-evaluation
 ^ Enable proof-by-logical-evaluation locally, per function
 ^ Enable extensional interpretation of function equality
 ^ No inference of polymorphic type application.
 ^ Allow "reflection"; switches on "--higherorder" and "--exactdc"
 ^ Only "compile" the spec -- into .bspec file -- don't do any checking.
 ^ Do not check the transitive imports
 ^ 
 ^ Enable termination checking for rewriting
 ^ Skip this module entirely (don't even compile any specs in it)
 ^ Maximum PLE "fuel" (unfold depth) (default=infinite) 
 ^ Perform environment reduction
 ^ Don't perform environment reduction
 Sometimes improves performance and sometimes worsens it.
 ^ Use pandoc to generate html

# LANGUAGE DeriveGeneric #

module Language.Haskell.Liquid.UX.Config (
     Config (..)
   , HasConfig (..)
   , allowPLE, allowLocalPLE, allowGlobalPLE
   , patternFlag
   , higherOrderFlag
   , pruneFlag
   , maxCaseExpand
   , exactDCFlag
   , hasOpt
   , totalityCheck
   , terminationCheck
   , structuralTerm
   ) where

import Prelude hiding (error)
import Language.Fixpoint.Types.Config hiding (Config)
import GHC.Generics
import System.Console.CmdArgs

data Config = Config
  ^ Adds precise reasoning on presence of rankNTypes
  ^ check internal ( GHC - derived ) binders
  ^ name of smtsolver to use [ default : try z3 , cvc4 , mathsat in order ]
  ^ command - line options to pass to GHC
  ^ .c files to compile and link against ( for GHC )
  ^ eliminate ( i.e. do n't use  for ) for " none " , " cuts " or " all " kvars
  ^ expect failure from Liquid with at least one of the following messages
  ^ eliminate upto given depth of KVar chains
  ^ treat code patterns ( e.g. e1 > > = \x - > e2 ) specially for inference
  ^ simplify GHC core before constraint - generation
  ^ Disable non - concrete KVar slicing
  ^ Unfold invocations with undecided guards in PLE
  ^ Use an interpreter to assist PLE
  ^ enable  support .
  , noLazyPLE                :: Bool
  ^ Inline ANF bindings .
  } deriving (Generic, Data, Typeable, Show, Eq)

allowPLE :: Config -> Bool
allowPLE cfg
  =  allowGlobalPLE cfg
  || allowLocalPLE cfg

allowGlobalPLE :: Config -> Bool
allowGlobalPLE cfg = proofLogicEval  cfg

allowLocalPLE :: Config -> Bool
allowLocalPLE cfg = proofLogicEvalLocal  cfg

instance HasConfig  Config where
  getConfig x = x

class HasConfig t where
  getConfig :: t -> Config

patternFlag :: (HasConfig t) => t -> Bool
patternFlag = not . noPatternInline . getConfig

higherOrderFlag :: (HasConfig t) => t -> Bool
higherOrderFlag x = higherorder cfg || reflection cfg
  where
    cfg           = getConfig x

exactDCFlag :: (HasConfig t) => t -> Bool
exactDCFlag x = exactDC cfg || reflection cfg
  where
    cfg       = getConfig x

pruneFlag :: (HasConfig t) => t -> Bool
pruneFlag = pruneUnsorted . getConfig

maxCaseExpand :: (HasConfig t) => t -> Int
maxCaseExpand = caseExpandDepth . getConfig

hasOpt :: (HasConfig t) => t -> (Config -> Bool) -> Bool
hasOpt t f = f (getConfig t)

totalityCheck :: (HasConfig t) => t -> Bool
totalityCheck = totalityCheck' . getConfig

terminationCheck :: (HasConfig t) => t -> Bool
terminationCheck = terminationCheck' . getConfig

totalityCheck' :: Config -> Bool
totalityCheck' cfg = not (nototality cfg) || totalHaskell cfg

terminationCheck' :: Config -> Bool
terminationCheck' cfg = totalHaskell cfg || not (notermination cfg)

structuralTerm :: (HasConfig a) => a -> Bool
structuralTerm = not . nostructuralterm . getConfig
