module Hint.All(
Hint(..), HintBuiltin(..), DeclHint, ModuHint,
resolveHints, hintRules, builtinHints
) where
import Data.Monoid
import Config.Type
import Data.Either
import Data.List.Extra
import Hint.Type
import Timing
import Util
import Prelude
import Hint.Match
import Hint.List
import Hint.ListRec
import Hint.Monad
import Hint.Lambda
import Hint.Bracket
import Hint.Naming
import Hint.Pattern
import Hint.Import
import Hint.Export
import Hint.Pragma
import Hint.Restrict
import Hint.Extensions
import Hint.Duplicate
import Hint.Comment
import Hint.Unsafe
import Hint.NewType
import Hint.Smell
data HintBuiltin =
HintList | HintListRec | HintMonad | HintLambda |
HintBracket | HintNaming | HintPattern | HintImport | HintExport |
HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict |
HintComment | HintNewType | HintSmell
deriving (Show,Eq,Ord,Bounded,Enum)
builtin :: HintBuiltin -> Hint
builtin x = case x of
HintList -> decl listHint
HintListRec -> decl listRecHint
HintMonad -> decl monadHint
HintLambda -> decl lambdaHint
HintBracket -> decl bracketHint
HintNaming -> decl namingHint
HintPattern -> decl patternHint
HintImport -> modu importHint
HintExport -> modu exportHint
HintPragma -> modu pragmaHint
HintExtensions -> modu extensionsHint
HintUnsafe -> decl unsafeHint
HintDuplicate -> mods duplicateHint
HintComment -> comm commentHint
HintNewType -> decl newtypeHint
HintRestrict -> mempty{hintModule=restrictHint}
HintSmell -> mempty{hintDecl=smellHint,hintModule=smellModuleHint}
where
wrap = timed "Hint" (drop 4 $ show x) . forceList
decl f = mempty{hintDecl=const $ \a b c -> wrap $ f a b c}
modu f = mempty{hintModule=const $ \a b -> wrap $ f a b}
mods f = mempty{hintModules=const $ \a -> wrap $ f a}
comm f = mempty{hintComment=const $ \a -> wrap $ f a}
builtinHints :: [(String, Hint)]
builtinHints = [(drop 4 $ show h, builtin h) | h <- [minBound .. maxBound]]
resolveHints :: [Either HintBuiltin HintRule] -> Hint
resolveHints xs = mconcat $ mempty{hintDecl=const $ readMatch rights} : map builtin (nubOrd lefts)
where (lefts,rights) = partitionEithers xs
hintRules :: [HintRule] -> Hint
hintRules = resolveHints . map Right