module Hint.All(
Hint(..), 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
HintLambda -> decl lambdaHint
HintImport -> modu importHint
HintExport -> modu exportHint
HintComment -> modu commentHint
HintPragma -> modu pragmaHint
HintDuplicate -> mods duplicateHint
HintRestrict -> mempty{hintModule=restrictHint}
HintList -> decl listHint
HintNewType -> decl newtypeHint
HintUnsafe -> decl unsafeHint
HintListRec -> decl listRecHint
HintNaming -> decl namingHint
HintBracket -> decl bracketHint
HintSmell -> mempty{hintDecl=smellHint,hintModule=smellModuleHint}
HintPattern -> decl patternHint
HintMonad -> decl monadHint
HintExtensions -> modu extensionsHint
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}
builtinHints :: [(String, Hint)]
builtinHints = [(drop 4 $ show h, builtin h) | h <- enumerate]
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