module Hints (hints) where

import Control.Monad (liftM,mapM)
import Control.Arrow (first)
import Types
import Guid


--------  Text and Elements  --------

str2elem = hasType (string ==> element) [ "image","video","plainText" ]

textToText = [ "header", "italic", "bold", "underline"
             , "overline", "strikeThrough", "monospace" ]

textAttrs = [ "toText" -: string ==> text
            , "link"   -: string ==> text ==> text
            , "Text.height" -: IntT ==> text ==> text
            ] ++ hasType (text ==> text) textToText

elements = let iee = IntT ==> element ==> element in
           [ "flow"    -: direction ==> listOf element ==> element
           , "layers"  -: listOf element ==> element
           , "text"    -: text ==> element
           , "opacity" -: iee
           , "width"   -: iee
           , "height"  -: iee
           , "size"    -: IntT ==> iee
           , "box"     -: iee
           , "centeredText"  -: text ==> element
           , "justifiedText" -: text ==> element
           , "collage" -: IntT ==> IntT ==> listOf form ==> element
           ]

directions = hasType direction ["up","down","left","right","inward","outward"]
colors = [ "rgb"  -: IntT ==> IntT ==> IntT ==> color
         , "rgba" -: IntT ==> IntT ==> IntT ==> IntT ==> color
         ] ++ hasType color ["red","green","blue","black","white"]

lineTypes = [ "line"       -: listOf point ==> line
            , "customLine" -: listOf IntT ==> color ==> line ==> form
            ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]

shapes = [ "polygon"       -: listOf point ==> point ==> shape
         , "filled"        -: color ==> shape ==> form
         , "outlined"      -: color ==> shape ==> form
         , "customOutline" -: listOf IntT ==> color ==> shape ==> form
         ] ++ hasType (IntT ==> IntT ==> point ==> shape) ["ngon","rect","oval"]


--------  Foreign  --------

casts =
  [ "castJSBoolToBool"       -: jsBool ==> BoolT
  , "castBoolToJSBool"       -: BoolT ==> jsBool
  , "castJSNumberToInt"      -: jsNumber ==> IntT
  , "castIntToJSNumber"      -: IntT ==> jsNumber
  , "castJSElementToElement" -: IntT ==> IntT ==> jsElement ==> element
  , "castElementToJSElement" -: element ==> jsElement
  , "castJSStringToString"   -: jsString ==> string
  , "castStringToJSString"   -: string ==> jsString
  --  , "castJSNumberToFloat -: 
  --  , "castFloatToJSNumber -:
  ]

polyCasts = sequence
  [ do a <- var     ; "castJSArrayToList"   -:: jsArray a ==> listOf a
  , do a <- var     ; "castListToJSArray"   -:: listOf a ==> jsArray a
  , do vs <- vars 2 ; "castTupleToJSTuple2" -:: tupleOf vs ==> jsTuple vs
  , do vs <- vars 3 ; "castTupleToJSTuple3" -:: tupleOf vs ==> jsTuple vs
  , do vs <- vars 4 ; "castTupleToJSTuple4" -:: tupleOf vs ==> jsTuple vs
  , do vs <- vars 5 ; "castTupleToJSTuple5" -:: tupleOf vs ==> jsTuple vs
  , do vs <- vars 2 ; "castJSTupleToTuple2" -:: jsTuple vs ==> tupleOf vs
  , do vs <- vars 3 ; "castJSTupleToTuple3" -:: jsTuple vs ==> tupleOf vs
  , do vs <- vars 4 ; "castJSTupleToTuple4" -:: jsTuple vs ==> tupleOf vs
  , do vs <- vars 5 ; "castJSTupleToTuple5" -:: jsTuple vs ==> tupleOf vs
  ]


--------  Signals  --------

sig ts = fn ts ==> fn (map signalOf ts)
    where fn = foldr1 (==>)

signals = sequence
    [ do ts <- vars 1 ; "constant" -:: sig ts
    , do ts <- vars 2 ; "lift"     -:: sig ts
    , do ts <- vars 3 ; "lift2"    -:: sig ts
    , do ts <- vars 4 ; "lift3"    -:: sig ts
    , do ts <- vars 5 ; "lift4"    -:: sig ts
    , do [a,b] <- vars 2 
         "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b
    , do a <- var ; "randomize" -:: IntT ==> IntT ==> signalOf a ==> signalOf IntT
    , do a <- var ; "count"     -:: signalOf a ==> signalOf IntT
    , do a <- var ; "keepIf"    -:: (a==>BoolT) ==> a ==> signalOf a ==> signalOf a
    , do a <- var ; "dropIf"    -:: (a==>BoolT) ==> a ==> signalOf a ==> signalOf a
    , do a <- var ; "keepWhen"  -:: signalOf BoolT ==>a==> signalOf a ==> signalOf a
    , do a <- var ; "dropWhen"  -:: signalOf BoolT ==>a==> signalOf a ==> signalOf a
    , do a <- var ; "dropRepeats" -:: signalOf a ==> signalOf a
    , do [a,b] <- vars 2 ; "sampleOn" -:: signalOf a ==> signalOf b ==> signalOf b
    ]

concreteSignals = 
  [ "keysDown"    -: signalOf (listOf IntT)
  , "charPressed" -: signalOf (maybeOf IntT)
  , "inRange"     -: IntT ==> IntT ==> signalOf IntT
  , "every"       -: time ==> signalOf time
  , "before"      -: time ==> signalOf BoolT
  , "after"       -: time ==> signalOf BoolT
  , "dimensions"  -: signalOf point
  , "position"    -: signalOf point
  , "x"           -: signalOf IntT
  , "y"           -: signalOf IntT
  , "isDown"      -: signalOf BoolT
  , "isClicked"   -: signalOf BoolT
  , "textField"   -: string ==> tupleOf [element, signalOf string]
  , "password"    -: string ==> tupleOf [element, signalOf string]
  , "textArea"    -: IntT ==> IntT ==> tupleOf [element, signalOf string]
  , "checkBox"    -: BoolT ==> tupleOf [element, signalOf BoolT]
  , "button"      -: string ==> tupleOf [element, signalOf BoolT]
  , "stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]
  ]

--------  Math and Binops  --------

iii = IntT ==> IntT ==> IntT
xxb x = x ==> x ==> BoolT

math =
  hasType (IntT ==> iii) ["clamp"] ++
  hasType iii ["+", "-", "*", "/","rem","mod","logBase","max","min"] ++
  hasType (IntT ==> IntT) ["sin","cos","tan","asin","acos","atan","sqrt","abs"]

bool =
  [ "not" -: BoolT ==> BoolT ] ++
  hasType (xxb BoolT) ["&&","||"] ++
  hasType (xxb IntT)  ["<",">","<=",">="]


--------  Polymorphic Functions  --------

var = VarT `liftM` guid
vars n = mapM (const var) [1..n]

infix 8 -::
name -:: tipe = return $ name -: tipe

funcs = sequence
    [ do a <- var          ; "id"   -:: a ==> a
    , do a <- var          ; "=="   -:: a ==> a ==> BoolT
    , do a <- var          ; "/="   -:: a ==> a ==> BoolT
    , do [a,b,c] <- vars 3 ; "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
    , do [a,b,c] <- vars 3 ; "."    -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
    , do [a,b] <- vars 2   ; "$"    -:: (a ==> b) ==> a ==> b
    , do a <- var ; ":"       -:: a ==> listOf a ==> listOf a
    , do a <- var ; "++"      -:: a ==> a ==> a
    , do a <- var ; "Cons"    -:: a ==> listOf a ==> listOf a 
    , do a <- var ; "Nil"     -:: listOf a
    , do a <- var ; "Just"    -:: a ==> ADT "Maybe" [a]
    , do a <- var ; "Nothing" -:: ADT "Maybe" [a]
    , "elmRange" -:: IntT ==> IntT ==> listOf IntT
    ]

ints = map (-: (listOf IntT ==> IntT)) [ "sum","product","maximum","minimum" ]

lists = liftM (++ints) . sequence $
    [ "and"  -:: listOf BoolT ==> BoolT
    , "or"   -:: listOf BoolT ==> BoolT
    , "sort" -:: listOf IntT ==> listOf IntT
    , do a <- var ; "head"    -:: listOf a ==> a
    , do a <- var ; "tail"    -:: listOf a ==> listOf a
    , do a <- var ; "length"  -:: listOf a ==> IntT
    , do a <- var ; "filter"  -:: (a ==> BoolT) ==> listOf a ==> listOf a
    , do a <- var ; "foldr1"  -:: (a ==> a ==> a) ==> listOf a ==> a
    , do a <- var ; "foldl1"  -:: (a ==> a ==> a) ==> listOf a ==> a
    , do a <- var ; "scanl1"  -:: (a ==> a ==> a) ==> listOf a ==> a
    , do a <- var ; "forall"  -:: (a ==> BoolT) ==> listOf a ==> BoolT
    , do a <- var ; "exists"  -:: (a ==> BoolT) ==> listOf a ==> BoolT
    , do a <- var ; "concat"  -:: listOf (listOf a) ==> listOf a
    , do a <- var ; "reverse" -:: listOf a ==> listOf a
    , do a <- var ; "take"    -:: IntT ==> listOf a ==> listOf a
    , do a <- var ; "drop"    -:: IntT ==> listOf a ==> listOf a
    , do a <- var ; "partition"    -:: (a==>BoolT)==>listOf a==>tupleOf [listOf a,listOf a]
    , do a <- var ; "intersperse"  -:: a ==> listOf a ==> listOf a
    , do a <- var ; "intercalate"  -:: listOf a ==> listOf(listOf a) ==> listOf a
    , do [a,b] <- vars 2 ; "zip"   -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
    , do [a,b] <- vars 2 ; "map"   -:: (a ==> b) ==> listOf a ==> listOf b
    , do [a,b] <- vars 2 ; "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
    , do [a,b] <- vars 2 ; "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
    , do [a,b] <- vars 2 ; "scanl" -:: (a==>b==>b)==>b==>listOf a==>listOf b
    , do [a,b] <- vars 2 ; "concatMap" -:: (a==>listOf b)==>listOf a ==> listOf b
    , do [a,b,c] <- vars 3
         "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
    ]


--------  Everything  --------

hints = do
  fs <- funcs ; ls <- lists ; ss <- signals ; pcasts <- polyCasts
  return $ concat [ fs, ls, ss, math, bool, str2elem, textAttrs
                  , elements, directions, colors, lineTypes, shapes
                  , concreteSignals, casts, pcasts
                  ]