git.iko.soy/typeable/elm-ui
on master help sign in
reimplement text input. resolves #5, resolves #95
commit5e279d8161fa1d5436416a8922d8cef3c3d2c4f1 authorMatthew Griffith <mdg.griffith@gmail.com> dateWed 19 Jun 2019, 09:17 (7 years ago) parent94ce612
1 file changed+304−302
src/Element/Input.elm+304−302
src/Element/Input.elm+304−302
@@ -669,304 +669,150 @@ type alias Text msg =
669669 }
670670
671671
672−type Padding
673− = Padding Int Int Int Int
674−
675−
676−inheritablePlaceholderAttributes attr =
677− case attr of
678− Internal.StyleClass _ (Internal.PaddingStyle _ _ _ _ _) ->
679− True
680−
681− Internal.StyleClass _ (Internal.BorderWidth _ _ _ _ _) ->
682− True
683−
684− Internal.StyleClass _ (Internal.Transform _) ->
685− True
686−
687− _ ->
688− False
689−
690−
691−{-|
692−
693− attributes
694−
695− <parent>
696− attribute::width/height fill
697− attribtue::alignment
698− attribute::spacing
699− attribute::fontsize/family/lineheight
700− <el-wrapper>
701− attribute::nearby(placeholder)
702− attribute::width/height fill
703− inFront ->
704− placeholder
705− attribute::padding
706−
707−
708− <input>
709− textarea ->
710− special height for height-content
711− attribtue::padding
712− attribute::lineHeight
713− attributes
714− <label>
715−
716−-}
672+{-| -}
717673textHelper : TextInput -> List (Attribute msg) -> Text msg -> Element msg
718674textHelper textInput attrs textOptions =
719675 let
720− attributes =
676+ withDefaults =
721677 defaultTextBoxStyle ++ attrs
722678
723− behavior =
724− [ Internal.Attr (Html.Events.onInput textOptions.onChange) ]
725−
726− forPlaceholder =
727− List.filter inheritablePlaceholderAttributes attributes
679+ redistributed =
680+ redistribute withDefaults
728681
729− noNearbys =
730− List.filter (not << forNearby) attributes
682+ moveUpToCompensateForPadding =
683+ calcMoveToCompensateForPadding withDefaults
731684
732− forNearby attr =
685+ onlySpacing attr =
733686 case attr of
734− Internal.Nearby _ _ ->
687+ Internal.StyleClass _ (Internal.SpacingStyle _ _ _) ->
735688 True
736689
737690 _ ->
738691 False
739692
740− ( inputNode, inputAttrs, inputChildren ) =
693+ bottomPadding attr =
694+ case attr of
695+ Internal.StyleClass cls (Internal.PaddingStyle pad t r b l) ->
696+ Just
697+ (Element.paddingEach
698+ { top = 0
699+ , right = 0
700+ , bottom = b
701+ , left = 0
702+ }
703+ )
704+
705+ _ ->
706+ Nothing
707+
708+ heightContent =
741709 case textInput.type_ of
742710 TextInputNode inputType ->
743− ( "input"
744− , [ Internal.Attr (Html.Attributes.type_ inputType)
745− , value textOptions.text
746− , spellcheck textInput.spellchecked
747− , Internal.htmlClass classes.inputText
748− , case textInput.autofill of
749− Nothing ->
750− Internal.NoAttribute
751−
752− Just fill ->
753− autofill fill
754− ]
755− ++ noNearbys
756− , []
757− )
711+ False
758712
759713 TextArea ->
760− let
761− { maybePadding, heightContent, maybeSpacing, adjustedAttributes, maybeBorder } =
762− (value textOptions.text :: attributes)
763− |> List.foldr
764− (\attr found ->
765− case attr of
766− Internal.Describe _ ->
767− found
768−
769− Internal.Height len ->
770− case found.heightContent of
771− Nothing ->
772− { found
773− | heightContent = Just (Internal.isContent len)
774− , adjustedAttributes = attr :: found.adjustedAttributes
775− }
776−
777− _ ->
778− found
779−
780− Internal.StyleClass _ (Internal.BorderWidth _ t r b l) ->
781− case found.maybeBorder of
782− Nothing ->
783− { found
784− | maybeBorder = Just (Padding t r b l)
785− , adjustedAttributes = attr :: found.adjustedAttributes
786− }
787−
788− _ ->
789− found
790−
791− Internal.StyleClass _ (Internal.PaddingStyle _ t r b l) ->
792− case found.maybePadding of
793− Nothing ->
794− { found
795− | maybePadding = Just (Padding t r b l)
796−
797− -- Skip storing padding because it's being customized later
798− , adjustedAttributes = found.adjustedAttributes
799− }
800−
801− _ ->
802− found
803−
804− Internal.StyleClass _ (Internal.SpacingStyle _ x y) ->
805− case found.maybeSpacing of
806− Nothing ->
807− { found
808− | maybeSpacing = Just y
809− , adjustedAttributes = attr :: found.adjustedAttributes
810− }
811−
812− _ ->
813− found
814−
815− _ ->
816− { found | adjustedAttributes = attr :: found.adjustedAttributes }
817− )
818− { maybePadding = Nothing
819− , heightContent = Nothing
820− , maybeBorder = Nothing
821− , maybeSpacing = Nothing
822− , adjustedAttributes = []
823− }
824−
825− -- NOTE: This is where default text spacing is set
826− spacing =
827− Maybe.withDefault 5 maybeSpacing
828− in
829− ( "textarea"
830− , [ spellcheck textInput.spellchecked
831− , Internal.htmlClass classes.inputMultiline
832− , Maybe.map autofill textInput.autofill
833− |> Maybe.withDefault Internal.NoAttribute
834− , case maybePadding of
835− Nothing ->
836− Internal.NoAttribute
837−
838− Just (Padding t r b l) ->
839− Element.paddingEach
840− { top = max 0 (t - (spacing // 2))
841− , bottom = max 0 (b - (spacing // 2))
842− , left = l
843− , right = r
844− }
845− , case heightContent of
846− Nothing ->
847− Internal.NoAttribute
848−
849− Just True ->
850− textHeightContent textOptions.text spacing maybePadding maybeBorder
851−
852− Just False ->
853− Internal.NoAttribute
854− ]
855− ++ adjustedAttributes
856− , [ Internal.unstyled (Html.text textOptions.text) ]
857− )
858−
859− heightFillFromChild =
860− Internal.get attributes <|
861− \attr ->
862− case attr of
863− Internal.Height (Internal.Fill _) ->
864− True
865−
866− _ ->
867− False
868−
869− attributesFromChild =
870− Internal.get attributes <|
871− \attr ->
872− case attr of
873− Internal.Width (Internal.Fill _) ->
874− True
875−
876− Internal.Height (Internal.Fill _) ->
877− True
878−
879− Internal.AlignX _ ->
880− True
881−
882− Internal.AlignY _ ->
883− True
884−
885− Internal.StyleClass _ (Internal.SpacingStyle _ _ _) ->
886− True
887−
888− Internal.StyleClass _ (Internal.FontSize _) ->
889− True
890−
891− Internal.StyleClass _ (Internal.FontFamily _ _) ->
892− True
893−
894− _ ->
895− False
896−
897− nearbys =
898− Internal.get attributes <|
899− \attr ->
900− case attr of
901− Internal.Nearby _ _ ->
902− True
903−
904− _ ->
905− False
906−
907− inputPadding =
908− Internal.get attributes <|
909− \attr ->
910− case attr of
911− Internal.StyleClass _ (Internal.PaddingStyle _ _ _ _ _) ->
912− True
913−
914− _ ->
915− False
714+ Maybe.withDefault False redistributed.heightContent
916715
917716 inputElement =
918717 Internal.element
919718 Internal.asEl
920− Internal.div
921− (Element.width Element.fill
922− :: List.concat
923− [ nearbys
924− , heightFillFromChild
925− , case textOptions.placeholder of
926− Nothing ->
927− []
928−
929− Just (Placeholder placeholderAttrs placeholderEl) ->
930− [ Element.inFront
931− (Element.el
932− (defaultTextPadding
933− :: forPlaceholder
934− ++ [ Font.color charcoal
935− , Internal.htmlClass (classes.noTextSelection ++ " " ++ classes.passPointerEvents)
936− , Border.color (Element.rgba 0 0 0 0)
937− , Background.color (Element.rgba 0 0 0 0)
938− , Element.height Element.fill
939− , Element.width Element.fill
940− , Element.alpha
941− (if textOptions.text == "" then
942− 1
943−
944− else
945− 0
946− )
947− ]
948− ++ placeholderAttrs
949− )
950− placeholderEl
951− )
719+ (case textInput.type_ of
720+ TextInputNode inputType ->
721+ Internal.NodeName "input"
722+
723+ TextArea ->
724+ Internal.NodeName "textarea"
725+ )
726+ ([ value textOptions.text
727+ , Internal.Attr (Html.Events.onInput textOptions.onChange)
728+ , Internal.htmlClass "focusable"
729+ , hiddenLabelAttribute textOptions.label
730+ , spellcheck textInput.spellchecked
731+ , Maybe.map autofill textInput.autofill
732+ |> Maybe.withDefault Internal.NoAttribute
733+ ]
734+ ++ (case textInput.type_ of
735+ TextInputNode inputType ->
736+ [ Internal.Attr (Html.Attributes.type_ inputType)
737+ , Internal.htmlClass classes.inputText
952738 ]
953− ]
739+
740+ TextArea ->
741+ [ Element.clip
742+ , Element.height Element.fill
743+ , Internal.htmlClass classes.inputMultiline
744+ , Element.alpha 0.3
745+ , moveUpToCompensateForPadding
746+ ]
747+ )
748+ ++ redistributed.input
954749 )
955− (Internal.Unkeyed
956− [ Internal.element
750+ (Internal.Unkeyed [])
751+
752+ wrappedInput =
753+ -- if heightContent then
754+ case textInput.type_ of
755+ TextArea ->
756+ -- textarea with height-content means that
757+ -- the input element is rendered `inFront` and transparently.
758+ -- Then the input text is rendered as the actual element.
759+ Internal.element
957760 Internal.asEl
958− (Internal.NodeName inputNode)
959− (List.concat
960− [ [ focusDefault attrs
961− , hiddenLabelAttribute textOptions.label
962− ]
963− , inputAttrs
964− , behavior
761+ Internal.div
762+ ([ Element.width Element.fill
763+ , Element.height (Element.px 100)
764+ , Element.scrollbarY
765+ ]
766+ ++ redistributed.parent
767+ )
768+ (Internal.Unkeyed
769+ [ Internal.element
770+ Internal.asParagraph
771+ Internal.div
772+ (Element.width Element.fill
773+ :: Element.height Element.fill
774+ :: Element.inFront inputElement
775+ :: Internal.htmlClass classes.inputMultiline
776+ :: List.concat
777+ [ if heightContent then
778+ List.filter onlySpacing redistributed.parent
779+ -- redistributed.parent
780+
781+ else
782+ List.filter onlySpacing redistributed.parent
783+ ++ List.filterMap bottomPadding redistributed.parent
784+ , case textOptions.placeholder of
785+ Nothing ->
786+ []
787+
788+ Just place ->
789+ [ renderPlaceholder place redistributed.cover (textOptions.text == "")
790+ ]
791+ ]
792+ )
793+ (Internal.Unkeyed
794+ [ Internal.unstyled (Html.text textOptions.text) ]
795+ )
965796 ]
966797 )
967− (Internal.Unkeyed inputChildren)
968− ]
969− )
798+
799+ TextInputNode inputType ->
800+ Internal.element
801+ Internal.asEl
802+ Internal.div
803+ (Element.width Element.fill
804+ :: List.concat
805+ [ redistributed.parent
806+ , case textOptions.placeholder of
807+ Nothing ->
808+ []
809+
810+ Just place ->
811+ [ renderPlaceholder place redistributed.cover (textOptions.text == "")
812+ ]
813+ ]
814+ )
815+ (Internal.Unkeyed [ inputElement ])
970816 in
971817 applyLabel
972818 (Internal.Class Flag.cursor classes.cursorText
@@ -978,45 +824,201 @@ textHelper textInput attrs textOptions =
978824 5
979825 )
980826 :: Region.announce
981− :: attributesFromChild
827+ :: redistributed.fullParent
982828 )
983829 textOptions.label
984− inputElement
830+ wrappedInput
831+
832+
833+renderPlaceholder (Placeholder placeholderAttrs placeholderEl) forPlaceholder on =
834+ Element.inFront
835+ (Element.el
836+ (defaultTextPadding
837+ :: forPlaceholder
838+ ++ [ Font.color charcoal
839+ , Internal.htmlClass (classes.noTextSelection ++ " " ++ classes.passPointerEvents)
840+ , Border.color (Element.rgba 0 0 0 0)
841+ , Background.color (Element.rgba 0 0 0 0)
842+ , Element.height Element.fill
843+ , Element.width Element.fill
844+ , Element.alpha
845+ (if on then
846+ 1
847+
848+ else
849+ 0
850+ )
851+ ]
852+ ++ placeholderAttrs
853+ )
854+ placeholderEl
855+ )
985856
986857
987−textHeightContent textValue spacing maybePadding maybeBorder =
858+{-| Because textareas are now shadowed, where they're rendered twice,
859+we to move the literal text area up because spacing is based on line height.
860+-}
861+calcMoveToCompensateForPadding : List (Attribute msg) -> Attribute msg
862+calcMoveToCompensateForPadding attrs =
988863 let
989− newlineCount =
990− String.lines textValue
991− |> List.length
992− |> (\x ->
993− if x < 1 then
994− 1
864+ gatherSpacing attr found =
865+ case attr of
866+ Internal.StyleClass _ (Internal.SpacingStyle _ x y) ->
867+ case found of
868+ Nothing ->
869+ Just y
995870
996− else
997− x
998− )
871+ _ ->
872+ found
999873
1000− topBottom (Padding t _ b _) =
1001− t + b
874+ _ ->
875+ found
876+ in
877+ case List.foldr gatherSpacing Nothing attrs of
878+ Nothing ->
879+ Internal.NoAttribute
1002880
1003− additionalSpacing =
1004− ((newlineCount - 1) * spacing)
1005− + Maybe.withDefault 0 (Maybe.map topBottom maybePadding)
1006− + Maybe.withDefault 0 (Maybe.map topBottom maybeBorder)
881+ Just vSpace ->
882+ Element.moveUp (toFloat vSpace / 2)
1007883
1008− heightValue count =
1009− "calc("
1010− ++ String.fromInt count
1011− ++ "em + "
1012− ++ String.fromInt additionalSpacing
1013− ++ "px) !important"
1014− in
1015− Internal.StyleClass Flag.heightTextAreaContent
1016− (Internal.Single ("textarea-height-" ++ String.fromInt newlineCount)
1017− "height"
1018− (heightValue newlineCount)
1019− )
884+
885+{-| Given the list of attributes provided to `Input.multiline` or `Input.text`,
886+
887+redistribute them to the parent, the input, or the cover.
888+
889+ - fullParent -> Wrapper around label and input
890+ - parent -> wrapper around input
891+ - cover -> things like placeholders or text areas which are layered on top of input.
892+ - input -> actual input element
893+
894+-}
895+redistribute :
896+ List (Attribute msg)
897+ ->
898+ { parent : List (Attribute msg)
899+ , fullParent : List (Attribute msg)
900+ , input : List (Attribute msg)
901+ , cover : List (Attribute msg)
902+ , heightContent : Maybe Bool
903+ }
904+redistribute attrs =
905+ List.foldl redistributeOver { fullParent = [], parent = [], input = [], cover = [], heightContent = Nothing } attrs
906+ |> (\redist ->
907+ { parent = List.reverse redist.parent
908+ , fullParent = List.reverse redist.fullParent
909+ , input = List.reverse redist.input
910+ , cover = List.reverse redist.cover
911+ , heightContent = redist.heightContent
912+ }
913+ )
914+
915+
916+redistributeOver attr els =
917+ case attr of
918+ Internal.Nearby _ _ ->
919+ { els | parent = attr :: els.parent }
920+
921+ Internal.Width (Internal.Fill _) ->
922+ { els | fullParent = attr :: els.fullParent }
923+
924+ Internal.Width _ ->
925+ { els | parent = attr :: els.parent }
926+
927+ Internal.Height h ->
928+ case h of
929+ Internal.Content ->
930+ { els
931+ | parent = attr :: els.parent
932+ , heightContent =
933+ els.heightContent
934+ |> orElse True
935+ }
936+
937+ _ ->
938+ { els
939+ | parent = attr :: els.parent
940+ , heightContent =
941+ els.heightContent
942+ |> orElse False
943+ }
944+
945+ Internal.AlignX _ ->
946+ { els | fullParent = attr :: els.fullParent }
947+
948+ Internal.AlignY _ ->
949+ { els | fullParent = attr :: els.fullParent }
950+
951+ Internal.StyleClass _ (Internal.SpacingStyle _ _ _) ->
952+ { els
953+ | fullParent = attr :: els.fullParent
954+ , parent = attr :: els.parent
955+ , input = attr :: els.input
956+ }
957+
958+ Internal.StyleClass _ (Internal.PaddingStyle _ _ _ _ _) ->
959+ { els
960+ | parent = attr :: els.parent
961+ }
962+
963+ Internal.StyleClass _ (Internal.BorderWidth _ _ _ _ _) ->
964+ { els
965+ | parent = attr :: els.parent
966+ , cover = attr :: els.cover
967+ }
968+
969+ Internal.StyleClass _ (Internal.Transform _) ->
970+ { els
971+ | parent = attr :: els.parent
972+ , cover = attr :: els.cover
973+ }
974+
975+ Internal.StyleClass _ (Internal.FontSize _) ->
976+ { els | fullParent = attr :: els.fullParent }
977+
978+ Internal.StyleClass _ (Internal.FontFamily _ _) ->
979+ { els | fullParent = attr :: els.fullParent }
980+
981+ Internal.StyleClass _ _ ->
982+ { els | parent = attr :: els.parent }
983+
984+ Internal.NoAttribute ->
985+ els
986+
987+ Internal.Attr a ->
988+ { els | input = attr :: els.input }
989+
990+ Internal.Describe _ ->
991+ { els | input = attr :: els.input }
992+
993+ Internal.Class _ _ ->
994+ { els | parent = attr :: els.parent }
995+
996+ Internal.TransformComponent _ _ ->
997+ { els | input = attr :: els.input }
998+
999+
1000+orElse thing maybe =
1001+ case maybe of
1002+ Nothing ->
1003+ Just thing
1004+
1005+ _ ->
1006+ maybe
1007+
1008+
1009+inheritablePlaceholderAttributes attr =
1010+ case attr of
1011+ Internal.StyleClass _ (Internal.PaddingStyle _ _ _ _ _) ->
1012+ True
1013+
1014+ Internal.StyleClass _ (Internal.BorderWidth _ _ _ _ _) ->
1015+ True
1016+
1017+ Internal.StyleClass _ (Internal.Transform _) ->
1018+ True
1019+
1020+ _ ->
1021+ False
10201022
10211023
10221024{-| -}