Merge branch 'master' into dev
This commit is contained in:
commit
ac71ab1fd8
13 changed files with 205 additions and 52 deletions
|
@ -63,6 +63,7 @@ Library
|
||||||
Parse.Parse,
|
Parse.Parse,
|
||||||
Parse.Pattern,
|
Parse.Pattern,
|
||||||
Parse.Type,
|
Parse.Type,
|
||||||
|
Type.Alias,
|
||||||
Type.Constrain.Declaration,
|
Type.Constrain.Declaration,
|
||||||
Type.Constrain.Expression,
|
Type.Constrain.Expression,
|
||||||
Type.Constrain.Literal,
|
Type.Constrain.Literal,
|
||||||
|
@ -132,6 +133,7 @@ Executable elm
|
||||||
Parse.Parse,
|
Parse.Parse,
|
||||||
Parse.Pattern,
|
Parse.Pattern,
|
||||||
Parse.Type,
|
Parse.Type,
|
||||||
|
Type.Alias,
|
||||||
Type.Constrain.Declaration,
|
Type.Constrain.Declaration,
|
||||||
Type.Constrain.Expression,
|
Type.Constrain.Expression,
|
||||||
Type.Constrain.Literal,
|
Type.Constrain.Literal,
|
||||||
|
|
|
@ -1,4 +1,12 @@
|
||||||
|
|
||||||
|
Release 0.9.1
|
||||||
|
=============
|
||||||
|
|
||||||
|
* Switch to Tango color scheme, adding a bunch of nice colors
|
||||||
|
* add the greyscale function for easily producing greys
|
||||||
|
* Fix miscellaneous bugs in type checker
|
||||||
|
* Switch name of Matrix2D to Transform2D
|
||||||
|
|
||||||
Release 0.9
|
Release 0.9
|
||||||
===========
|
===========
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,7 @@ import Paths_Elm
|
||||||
import SourceSyntax.PrettyPrint (pretty, variable)
|
import SourceSyntax.PrettyPrint (pretty, variable)
|
||||||
import Text.PrettyPrint as P
|
import Text.PrettyPrint as P
|
||||||
import qualified Type.Type as Type
|
import qualified Type.Type as Type
|
||||||
import qualified Data.Traversable as Traverse
|
import qualified Type.Alias as Alias
|
||||||
|
|
||||||
data Flags =
|
data Flags =
|
||||||
Flags { make :: Bool
|
Flags { make :: Bool
|
||||||
|
@ -146,10 +146,9 @@ buildFile flags moduleNum numModules interfaces filePath =
|
||||||
True -> print . pretty $ program modul
|
True -> print . pretty $ program modul
|
||||||
return modul
|
return modul
|
||||||
|
|
||||||
if print_types flags then printTypes metaModule else return ()
|
if print_types flags then printTypes interfaces metaModule else return ()
|
||||||
tipes <- Traverse.traverse Type.toSrcType (types metaModule)
|
|
||||||
let interface = Canonical.interface name $ ModuleInterface {
|
let interface = Canonical.interface name $ ModuleInterface {
|
||||||
iTypes = tipes,
|
iTypes = types metaModule,
|
||||||
iAdts = datatypes metaModule,
|
iAdts = datatypes metaModule,
|
||||||
iAliases = aliases metaModule
|
iAliases = aliases metaModule
|
||||||
}
|
}
|
||||||
|
@ -160,11 +159,11 @@ buildFile flags moduleNum numModules interfaces filePath =
|
||||||
writeFile (elmo flags filePath) (jsModule metaModule)
|
writeFile (elmo flags filePath) (jsModule metaModule)
|
||||||
return (name,interface)
|
return (name,interface)
|
||||||
|
|
||||||
printTypes metaModule = do
|
printTypes interfaces metaModule = do
|
||||||
putStrLn ""
|
putStrLn ""
|
||||||
|
let rules = Alias.rules interfaces metaModule
|
||||||
forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
|
forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
|
||||||
pt <- Type.extraPretty t
|
print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
|
||||||
print $ variable n <+> P.text ":" <+> pt
|
|
||||||
putStrLn ""
|
putStrLn ""
|
||||||
|
|
||||||
getRuntime :: Flags -> IO FilePath
|
getRuntime :: Flags -> IO FilePath
|
||||||
|
|
|
@ -11,7 +11,6 @@ import System.FilePath as FP
|
||||||
import Text.PrettyPrint (Doc)
|
import Text.PrettyPrint (Doc)
|
||||||
|
|
||||||
import SourceSyntax.Everything
|
import SourceSyntax.Everything
|
||||||
import SourceSyntax.Type
|
|
||||||
import qualified Parse.Parse as Parse
|
import qualified Parse.Parse as Parse
|
||||||
import qualified Metadata.Prelude as Prelude
|
import qualified Metadata.Prelude as Prelude
|
||||||
import qualified Transform.Check as Check
|
import qualified Transform.Check as Check
|
||||||
|
|
|
@ -12,7 +12,6 @@ import SourceSyntax.Expression (LExpr)
|
||||||
import SourceSyntax.Declaration
|
import SourceSyntax.Declaration
|
||||||
import SourceSyntax.Type
|
import SourceSyntax.Type
|
||||||
import System.FilePath (joinPath)
|
import System.FilePath (joinPath)
|
||||||
import qualified Type.Type as Type
|
|
||||||
|
|
||||||
data Module tipe var =
|
data Module tipe var =
|
||||||
Module [String] Exports Imports [Declaration tipe var]
|
Module [String] Exports Imports [Declaration tipe var]
|
||||||
|
@ -30,7 +29,7 @@ data MetadataModule t v = MetadataModule {
|
||||||
exports :: [String],
|
exports :: [String],
|
||||||
imports :: [(String, ImportMethod)],
|
imports :: [(String, ImportMethod)],
|
||||||
program :: LExpr t v,
|
program :: LExpr t v,
|
||||||
types :: Map.Map String Type.Variable,
|
types :: Map.Map String Type,
|
||||||
fixities :: [(Assoc, Int, String)],
|
fixities :: [(Assoc, Int, String)],
|
||||||
aliases :: [(String, [String], Type)],
|
aliases :: [(String, [String], Type)],
|
||||||
datatypes :: [ (String, [String], [(String,[Type])]) ],
|
datatypes :: [ (String, [String], [(String,[Type])]) ],
|
||||||
|
|
|
@ -41,8 +41,11 @@ instance Pretty Type where
|
||||||
| Help.isTuple name -> P.parens . P.sep . P.punctuate P.comma $ map pretty tipes
|
| Help.isTuple name -> P.parens . P.sep . P.punctuate P.comma $ map pretty tipes
|
||||||
| otherwise -> P.hang (P.text name) 2 (P.sep $ map prettyParens tipes)
|
| otherwise -> P.hang (P.text name) 2 (P.sep $ map prettyParens tipes)
|
||||||
EmptyRecord -> P.braces P.empty
|
EmptyRecord -> P.braces P.empty
|
||||||
Record fields ext -> P.braces $ P.hang (pretty ext <+> P.text "|") 4 prettyFields
|
Record _ _ -> P.braces $ case ext of
|
||||||
|
EmptyRecord -> prettyFields
|
||||||
|
_ -> P.hang (pretty ext <+> P.text "|") 4 prettyFields
|
||||||
where
|
where
|
||||||
|
(fields, ext) = collectRecords tipe
|
||||||
prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
|
prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
|
||||||
prettyFields = commaSep . map prettyField $ fields
|
prettyFields = commaSep . map prettyField $ fields
|
||||||
|
|
||||||
|
@ -52,11 +55,19 @@ collectLambdas tipe =
|
||||||
Lambda arg body -> pretty arg : collectLambdas body
|
Lambda arg body -> pretty arg : collectLambdas body
|
||||||
_ -> [pretty tipe]
|
_ -> [pretty tipe]
|
||||||
|
|
||||||
|
collectRecords = go []
|
||||||
|
where
|
||||||
|
go fields tipe =
|
||||||
|
case tipe of
|
||||||
|
Record fs ext -> go (fs ++ fields) ext
|
||||||
|
_ -> (fields, tipe)
|
||||||
|
|
||||||
prettyParens tipe = parensIf needed (pretty tipe)
|
prettyParens tipe = parensIf needed (pretty tipe)
|
||||||
where
|
where
|
||||||
needed =
|
needed =
|
||||||
case tipe of
|
case tipe of
|
||||||
Lambda _ _ -> True
|
Lambda _ _ -> True
|
||||||
|
Data "_List" [_] -> False
|
||||||
Data _ [] -> False
|
Data _ [] -> False
|
||||||
Data _ _ -> True
|
Data _ _ -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
119
compiler/Type/Alias.hs
Normal file
119
compiler/Type/Alias.hs
Normal file
|
@ -0,0 +1,119 @@
|
||||||
|
module Type.Alias (realias, rules, canonicalRealias, Rules) where
|
||||||
|
|
||||||
|
import Control.Applicative ((<$>),(<*>))
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Arrow (second)
|
||||||
|
import Data.Map ((!))
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import qualified Data.List as List
|
||||||
|
import SourceSyntax.Type
|
||||||
|
import SourceSyntax.Module
|
||||||
|
|
||||||
|
type Rules = ([(String,[String],Type)], Type -> Type)
|
||||||
|
|
||||||
|
rules interfaces metaModule = (collect interfaces metaModule, localizer metaModule)
|
||||||
|
|
||||||
|
collect interfaces metaModule = filter (not . isPrimitive) rawAliases
|
||||||
|
where
|
||||||
|
rawAliases = aliases metaModule ++ concatMap iAliases (Map.elems interfaces)
|
||||||
|
|
||||||
|
isPrimitive (_,_,tipe) =
|
||||||
|
case tipe of
|
||||||
|
Data _ [] -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
localizer metaModule = go
|
||||||
|
where
|
||||||
|
go tipe =
|
||||||
|
case tipe of
|
||||||
|
Var _ -> tipe
|
||||||
|
EmptyRecord -> tipe
|
||||||
|
Lambda t1 t2 -> Lambda (go t1) (go t2)
|
||||||
|
Data name ts -> Data (localize name) (map go ts)
|
||||||
|
Record fs ext -> Record (map (second go) fs) (go ext)
|
||||||
|
|
||||||
|
byMethod = foldr (\(n,m) d -> Map.insertWith (++) n [m] d) Map.empty (imports metaModule)
|
||||||
|
|
||||||
|
separate name =
|
||||||
|
case List.elemIndices '.' name of
|
||||||
|
[] -> ("",name)
|
||||||
|
is -> let i = last is in
|
||||||
|
(take i name, drop (i+1) name)
|
||||||
|
|
||||||
|
shortest = List.minimumBy (\a b -> compare (length a) (length b))
|
||||||
|
|
||||||
|
localize name = shortest (name : concatMap (localize' value) methods)
|
||||||
|
where (modul, value) = separate name
|
||||||
|
methods = Map.findWithDefault [] modul byMethod
|
||||||
|
|
||||||
|
localize' name method =
|
||||||
|
case method of
|
||||||
|
As modul -> [modul ++ "." ++ name]
|
||||||
|
Hiding xs | name `notElem` xs -> [name]
|
||||||
|
Importing xs | name `elem` xs -> [name]
|
||||||
|
_ -> []
|
||||||
|
|
||||||
|
realias :: Rules -> Type -> Type
|
||||||
|
realias (aliases,localize) tipe = localize (canonicalRealias aliases tipe)
|
||||||
|
|
||||||
|
canonicalRealias :: [(String,[String],Type)] -> Type -> Type
|
||||||
|
canonicalRealias aliases tipe =
|
||||||
|
case concatMap tryRealias aliases of
|
||||||
|
[tipe''] -> f tipe''
|
||||||
|
_ -> if tipe == tipe' then tipe else f tipe'
|
||||||
|
where
|
||||||
|
tryRealias (name, args, t) =
|
||||||
|
case diff t tipe of
|
||||||
|
Nothing -> []
|
||||||
|
Just kvs ->
|
||||||
|
let holes = collectFields kvs
|
||||||
|
hasArgs = List.sort args == Map.keys holes
|
||||||
|
isConsistent = all allEqual (Map.elems holes)
|
||||||
|
in case hasArgs && isConsistent of
|
||||||
|
False -> []
|
||||||
|
True -> [Data name $ map (\arg -> head (holes ! arg)) args]
|
||||||
|
|
||||||
|
f = canonicalRealias aliases
|
||||||
|
tipe' =
|
||||||
|
case tipe of
|
||||||
|
Var _ -> tipe
|
||||||
|
EmptyRecord -> tipe
|
||||||
|
Lambda t1 t2 -> Lambda (f t1) (f t2)
|
||||||
|
Data name ts -> Data name (map f ts)
|
||||||
|
Record fs ext -> Record (map (second f) fs) (f ext)
|
||||||
|
|
||||||
|
allEqual [] = True
|
||||||
|
allEqual (x:xs) = all (==x) xs
|
||||||
|
|
||||||
|
diff :: Type -> Type -> Maybe [(String,Type)]
|
||||||
|
diff general specific =
|
||||||
|
case (general, specific) of
|
||||||
|
(Lambda g1 g2, Lambda s1 s2) -> (++) <$> diff g1 s1 <*> diff g2 s2
|
||||||
|
(Var x, t) -> Just [(x,t)]
|
||||||
|
(Data gname gts, Data sname sts)
|
||||||
|
| gname == sname && length gts == length sts ->
|
||||||
|
concat <$> zipWithM diff gts sts
|
||||||
|
(EmptyRecord, EmptyRecord) -> Just []
|
||||||
|
(Record _ _, Record _ _) ->
|
||||||
|
let (gfs,gext) = collectRecords general
|
||||||
|
(sfs,sext) = collectRecords specific
|
||||||
|
gfields = collectFields gfs
|
||||||
|
sfields = collectFields sfs
|
||||||
|
|
||||||
|
overlap = Map.intersectionWith (\gs ss -> length gs == length ss) sfields gfields
|
||||||
|
isAligned = Map.size gfields == Map.size overlap && and (Map.elems overlap)
|
||||||
|
in
|
||||||
|
case isAligned of
|
||||||
|
False -> Nothing
|
||||||
|
True -> let remaining = Map.difference sfields gfields
|
||||||
|
sext' = if Map.null remaining then sext else
|
||||||
|
Record (flattenFields remaining) sext
|
||||||
|
matchMap = Map.intersectionWith (zipWith diff) gfields sfields
|
||||||
|
in concat <$> sequence (diff gext sext' : concat (Map.elems matchMap))
|
||||||
|
(_,_) -> Nothing
|
||||||
|
|
||||||
|
collectFields fields =
|
||||||
|
foldr (\(f,t) fs -> Map.insertWith (++) f [t] fs) Map.empty fields
|
||||||
|
|
||||||
|
flattenFields fields =
|
||||||
|
concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)
|
|
@ -6,26 +6,38 @@ module Type.ExtraChecks (extraChecks) where
|
||||||
import Control.Applicative ((<$>),(<*>))
|
import Control.Applicative ((<$>),(<*>))
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.UnionFind.IO as UF
|
import qualified Data.UnionFind.IO as UF
|
||||||
import Type.Type ( Variable, structure, Term1(..) )
|
import Type.Type ( Variable, structure, Term1(..), toSrcType )
|
||||||
import Type.State (Env)
|
import Type.State (Env)
|
||||||
import Type.PrettyPrint ( pretty, ParensWhen(Never) )
|
import qualified Type.Alias as Alias
|
||||||
import Text.PrettyPrint as P
|
import Text.PrettyPrint as P
|
||||||
|
import SourceSyntax.PrettyPrint (pretty)
|
||||||
|
import SourceSyntax.Type (Type)
|
||||||
|
import qualified Data.Traversable as Traverse
|
||||||
|
|
||||||
extraChecks :: Env -> IO (Either [P.Doc] Env)
|
extraChecks :: Alias.Rules -> Env -> IO (Either [P.Doc] (Map.Map String Type))
|
||||||
extraChecks env =
|
extraChecks rules env = do
|
||||||
case mainCheck env of
|
eitherEnv <- occursCheck env
|
||||||
Left errs -> return $ Left errs
|
case eitherEnv of
|
||||||
Right env -> occursCheck env
|
Left errs -> return $ Left errs
|
||||||
|
Right env' ->
|
||||||
|
mainCheck rules <$> Traverse.traverse toSrcType env'
|
||||||
|
|
||||||
|
|
||||||
mainCheck :: Env -> Either [P.Doc] Env
|
mainCheck :: Alias.Rules -> (Map.Map String Type) -> Either [P.Doc] (Map.Map String Type)
|
||||||
mainCheck env =
|
mainCheck rules env =
|
||||||
|
let acceptable = ["Graphics.Element.Element","Signal.Signal Graphics.Element.Element"] in
|
||||||
case Map.lookup "main" env of
|
case Map.lookup "main" env of
|
||||||
Nothing -> Right env
|
Nothing -> Right env
|
||||||
Just var
|
Just tipe
|
||||||
| P.render (pretty Never var) `elem` ["Element","Signal Element"] -> Right env
|
| P.render (pretty (Alias.canonicalRealias (fst rules) tipe)) `elem` acceptable ->
|
||||||
|
Right env
|
||||||
| otherwise ->
|
| otherwise ->
|
||||||
Left [ P.vcat [ P.text "Type Error:"
|
Left [ P.vcat [ P.text "Type Error:"
|
||||||
, P.text "'main' must be an Element or a (Signal Element)\n" ] ]
|
, P.text "Bad type for 'main'. It must have type Element or a (Signal Element)"
|
||||||
|
, P.text "Instead 'main' has type:\n"
|
||||||
|
, P.nest 4 . pretty $ Alias.realias rules tipe
|
||||||
|
, P.text " " ]
|
||||||
|
]
|
||||||
|
|
||||||
occursCheck :: Env -> IO (Either [P.Doc] Env)
|
occursCheck :: Env -> IO (Either [P.Doc] Env)
|
||||||
occursCheck env = do
|
occursCheck env = do
|
||||||
|
|
|
@ -12,18 +12,19 @@ import SourceSyntax.Module as Module
|
||||||
import qualified SourceSyntax.Expression as Expr
|
import qualified SourceSyntax.Expression as Expr
|
||||||
import SourceSyntax.Location (Located, noneNoDocs)
|
import SourceSyntax.Location (Located, noneNoDocs)
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
|
import SourceSyntax.Type (Type)
|
||||||
import Text.PrettyPrint
|
import Text.PrettyPrint
|
||||||
import qualified Type.State as TS
|
import qualified Type.State as TS
|
||||||
import Type.ExtraChecks (extraChecks)
|
import Type.ExtraChecks (extraChecks)
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Arrow (second)
|
import Control.Arrow (second)
|
||||||
import Transform.SortDefinitions as Sort
|
import qualified Type.Alias as Alias
|
||||||
|
|
||||||
import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
|
import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
|
||||||
-- the IO monad. I don't think that'd be worthwhile.
|
-- the IO monad. I don't think that'd be worthwhile.
|
||||||
|
|
||||||
|
|
||||||
infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
|
infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String Type)
|
||||||
infer interfaces modul = unsafePerformIO $ do
|
infer interfaces modul = unsafePerformIO $ do
|
||||||
env <- Env.initialEnvironment
|
env <- Env.initialEnvironment
|
||||||
(datatypes modul ++ concatMap iAdts (Map.elems interfaces))
|
(datatypes modul ++ concatMap iAdts (Map.elems interfaces))
|
||||||
|
@ -45,8 +46,7 @@ infer interfaces modul = unsafePerformIO $ do
|
||||||
constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
|
constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
|
||||||
|
|
||||||
state <- execStateT (Solve.solve constraint) TS.initialState
|
state <- execStateT (Solve.solve constraint) TS.initialState
|
||||||
let errors = TS.sErrors state
|
let rules = Alias.rules interfaces modul
|
||||||
if null errors
|
case TS.sErrors state of
|
||||||
then extraChecks $ Map.difference (TS.sSavedEnv state) header
|
errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))
|
||||||
else Left `fmap` sequence (reverse errors)
|
[] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)
|
||||||
|
|
||||||
|
|
|
@ -11,6 +11,8 @@ import qualified Data.Traversable as Traversable
|
||||||
import Text.PrettyPrint as P
|
import Text.PrettyPrint as P
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
import SourceSyntax.Location
|
import SourceSyntax.Location
|
||||||
|
import qualified SourceSyntax.Type as Src
|
||||||
|
import qualified Type.Alias as Alias
|
||||||
|
|
||||||
-- Pool
|
-- Pool
|
||||||
-- Holds a bunch of variables
|
-- Holds a bunch of variables
|
||||||
|
@ -32,7 +34,7 @@ data SolverState = SS {
|
||||||
sSavedEnv :: Env,
|
sSavedEnv :: Env,
|
||||||
sPool :: Pool,
|
sPool :: Pool,
|
||||||
sMark :: Int,
|
sMark :: Int,
|
||||||
sErrors :: [IO P.Doc]
|
sErrors :: [Alias.Rules -> IO P.Doc]
|
||||||
}
|
}
|
||||||
|
|
||||||
initialState = SS {
|
initialState = SS {
|
||||||
|
@ -47,9 +49,19 @@ modifyEnv f = modify $ \state -> state { sEnv = f (sEnv state) }
|
||||||
modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
|
modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
|
||||||
|
|
||||||
addError span message t1 t2 =
|
addError span message t1 t2 =
|
||||||
modify $ \state -> state { sErrors = err : sErrors state }
|
modify $ \state -> state { sErrors = makeError : sErrors state }
|
||||||
where
|
where
|
||||||
err = makeError <$> extraPretty t1 <*> extraPretty t2
|
makeError rules = do
|
||||||
|
let prettiest = pretty . Alias.realias rules
|
||||||
|
t1' <- prettiest <$> toSrcType t1
|
||||||
|
t2' <- prettiest <$> toSrcType t2
|
||||||
|
return . P.vcat $
|
||||||
|
[ P.text $ "Type error" ++ location ++ ":"
|
||||||
|
, P.vcat . map P.text . lines $ if null message then defaultMessage else message
|
||||||
|
, P.text src
|
||||||
|
, P.text " Expected Type:" <+> t1'
|
||||||
|
, P.text " Actual Type:" <+> t2' <> P.text "\n"
|
||||||
|
]
|
||||||
|
|
||||||
location = case span of
|
location = case span of
|
||||||
NoSpan msg -> ""
|
NoSpan msg -> ""
|
||||||
|
@ -66,13 +78,6 @@ addError span message t1 t2 =
|
||||||
|
|
||||||
defaultMessage = "Something weird is happening with this value:"
|
defaultMessage = "Something weird is happening with this value:"
|
||||||
|
|
||||||
makeError pt1 pt2 =
|
|
||||||
P.vcat [ P.text $ "Type error" ++ location ++ ":"
|
|
||||||
, P.vcat . map P.text . lines $ if null message then defaultMessage else message
|
|
||||||
, P.text src
|
|
||||||
, P.text " Expected Type:" <+> pt1
|
|
||||||
, P.text " Actual Type:" <+> pt2 <> P.text "\n"
|
|
||||||
]
|
|
||||||
|
|
||||||
switchToPool pool = modifyPool (\_ -> pool)
|
switchToPool pool = modifyPool (\_ -> pool)
|
||||||
|
|
||||||
|
|
|
@ -46,17 +46,17 @@ darkRed = Color 164 0 0 1
|
||||||
black = Color 0 0 0 1
|
black = Color 0 0 0 1
|
||||||
white = Color 255 255 255 1
|
white = Color 255 255 255 1
|
||||||
|
|
||||||
lightGrey = Color 238 238 236
|
lightGrey = Color 238 238 236 1
|
||||||
grey = Color 211 215 207
|
grey = Color 211 215 207 1
|
||||||
darkGrey = Color 186 189 182
|
darkGrey = Color 186 189 182 1
|
||||||
|
|
||||||
lightGray = Color 238 238 236
|
lightGray = Color 238 238 236 1
|
||||||
gray = Color 211 215 207
|
gray = Color 211 215 207 1
|
||||||
darkGray = Color 186 189 182
|
darkGray = Color 186 189 182 1
|
||||||
|
|
||||||
lightCharcoal = Color 136 138 133
|
lightCharcoal = Color 136 138 133 1
|
||||||
charcoal = Color 85 87 83
|
charcoal = Color 85 87 83 1
|
||||||
darkCharcoal = Color 46 52 54
|
darkCharcoal = Color 46 52 54 1
|
||||||
|
|
||||||
grayscale : Float -> Color
|
grayscale : Float -> Color
|
||||||
grayscale p = hsv 0 0 (1-p)
|
grayscale p = hsv 0 0 (1-p)
|
||||||
|
|
|
@ -6,7 +6,7 @@ import List
|
||||||
import Either (Either, Left, Right)
|
import Either (Either, Left, Right)
|
||||||
import Transform2D (Transform2D, identity)
|
import Transform2D (Transform2D, identity)
|
||||||
import Native.Graphics.Collage
|
import Native.Graphics.Collage
|
||||||
import Graphics.Element (Element, Three, Pos, ElementPrim, Properties)
|
import Graphics.Element (Element)
|
||||||
import Color (Color, black, Gradient)
|
import Color (Color, black, Gradient)
|
||||||
import Maybe (Maybe)
|
import Maybe (Maybe)
|
||||||
import JavaScript (JSString)
|
import JavaScript (JSString)
|
||||||
|
|
|
@ -5,8 +5,7 @@ import Basics (String)
|
||||||
import Signal (Signal,lift,dropRepeats)
|
import Signal (Signal,lift,dropRepeats)
|
||||||
import Native.Graphics.Input
|
import Native.Graphics.Input
|
||||||
import List
|
import List
|
||||||
import Graphics.Element (Element, Three, Pos, ElementPrim, Properties)
|
import Graphics.Element (Element)
|
||||||
import Color (Color)
|
|
||||||
import Maybe (Maybe)
|
import Maybe (Maybe)
|
||||||
import JavaScript (JSString)
|
import JavaScript (JSString)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue