header coponent

example/spago.dhall

@@ -4,7 +4,14 @@ You can edit this file as you like.
 -}
 { name = "my-project"
 , dependencies =
-    [ "console", "datetime", "effect", "halogen", "psci-support", "uuid" ]
+    [ "console"
+    , "datetime"
+    , "effect"
+    , "halogen"
+    , "psci-support"
+    , "svg-parser-halogen"
+    , "uuid"
+    ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs", "../src/**/*.purs" ]
 }

spago.dhall

@@ -9,6 +9,7 @@ You can edit this file as you like.
     , "effect"
     , "halogen"
     , "psci-support"
+    , "svg-parser-halogen"
     , "uuid"
     , "web-html"
     ]

src/Bulma/Common.purs

@@ -3,20 +3,30 @@ module Bulma.Common
   , PickerState(..)
   , DisplayMode (..)
   , HeaderPosition (..)
+  , DateTimePickerType (..)
+  , DropDownState (..)
+  , Icons (..)
   , css
   , defaultSpec
   , pickerStateToString
   , displayModeToString
   , headerPosToString
+  , typeToString
+  , dropDownStateToString
   ) where
 
 import Prelude
+import Data.Foldable ( foldl )
+import Data.Either ( either )
+-- Internal
+import Bulma.SvgString
 -- UUID
 import Data.UUID ( UUID, emptyUUID )
 -- Halogen
 import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
+import Halogen.HTML.Core as HC
+import Svg.Renderer.Halogen ( parse )
 
 css :: forall r i. String -> HH.IProp ( class :: String | r ) i
 css = HP.class_ <<< HH.ClassName
@@ -24,8 +34,8 @@ css = HP.class_ <<< HH.ClassName
 type DateTimePickerSpec =
   { elemId :: UUID
   , pickerState :: PickerState
-  -- , type_ :: String
-  -- , color :: String
+  , type_ :: DateTimePickerType
+  , color :: String
   , isRange :: String
   -- , allowSameDae :: Boolean
   -- , lang :: String
@@ -56,31 +66,64 @@ type DateTimePickerSpec =
   -- , endTime :: Maybe String
   -- , minuteSteps :: Int
   , labelFrom :: String
+  , isModal :: String
   -- , labelTo :: String
   -- , closeOnOverlayClick :: Boolean
   -- , closeOnSelect :: Boolean
   -- , closeOnSelect :: Boolean
   -- , toggleOnInputClick :: Boolean
-  -- , icons :: Icons
+  , icons :: Icons
+  , dropDownState :: DropDownState
   }
 
 type Icons =
-  { previous :: String
-  , next :: String
-  , time :: String
-  , date :: String
+  { previous :: forall a action. HH.HTML a action
+  , next :: forall a action. HH.HTML a action
+  , time :: forall a action. HH.HTML a action
+  , date :: forall a action. HH.HTML a action
   }
 
+data DropDownState
+  = DropDownActive
+  | DropDownHidden
+
+dropDownStateToString :: DropDownState -> String
+dropDownStateToString = case _ of
+  DropDownActive -> "is-active"
+  DropDownHidden -> "is-hidden"
+
+
 defaultSpec :: DateTimePickerSpec
 defaultSpec =
   { elemId: emptyUUID
   , pickerState: PickerStateActive
   , labelFrom: mempty
   , isRange: mempty
-  , displayMode: DisplayModeHidden
+  , displayMode: DisplayModeEmpty
   , headerPosition: HeaderTop
+  , type_: DateTimePickerDate
+  , color: "is-primary"
+  , isModal: "is-hidden"
+  , dropDownState: DropDownActive
+  , icons:
+    { previous: previousIcon
+    , next: nextIcon
+    , time: timeIcon
+    , date: dateIcon
+    }
   }
 
+data DateTimePickerType
+  = DateTimePickerTime
+  | DateTimePickerDate
+  | DateTimePickerDateTime
+
+typeToString :: DateTimePickerType -> String
+typeToString = case _ of
+  DateTimePickerTime -> "is-hidden"
+  DateTimePickerDate ->  "is-date-only"
+  DateTimePickerDateTime -> ""
+
 data PickerState
   = PickerStateActive
   | PickerStateHidden
@@ -109,3 +152,28 @@ headerPosToString :: HeaderPosition -> String
 headerPosToString = case _ of
   HeaderTop -> ""
   HeaderBottom ->  "has-header-bottom"
+
+type Style =
+  { styleName :: String
+  , styleValue :: String
+  }
+
+styleProps :: forall r i. Array Style -> HP.IProp ( style :: String | r ) i
+styleProps = HH.prop ( HC.PropName "style" )
+  <<< foldl (\b a -> a.styleName <> ": " <> a.styleValue <> "; " <> b ) ""
+
+previousIcon :: forall a action. HH.HTML a action
+previousIcon = parseSvgString previousSvgString
+
+nextIcon :: forall a action. HH.HTML a action
+nextIcon = parseSvgString nextSvgString
+
+timeIcon :: forall a action. HH.HTML a action
+timeIcon = parseSvgString timeSvgString
+
+dateIcon :: forall a action. HH.HTML a action
+dateIcon = parseSvgString dateSvgString
+
+parseSvgString :: forall a action. String -> HH.HTML a action
+parseSvgString =
+  either ( const $ HH.text mempty ) identity <<< parse

src/Bulma/DatePicker.purs

@@ -5,6 +5,7 @@ import Prelude
 -- Internal
 import Bulma.Common ( DateTimePickerSpec )
 import Bulma.Common as Common
+import Bulma.Header as Header
 -- UUID
 import Data.UUID as UUID
 -- Halogen
@@ -16,6 +17,10 @@ type State =
   { options :: DateTimePickerSpec
   }
 
+type ChildSlot =
+  ( header :: Header.Slot Unit
+  )
+
 component :: forall q i o m. H.Component HH.HTML q i o m
 component =
   H.mkComponent
@@ -25,8 +30,7 @@ component =
     { handleAction = handleAction }
   }
 
-
-render :: forall action m. State -> H.ComponentHTML action () m
+render :: forall action m. State -> H.ComponentHTML action ChildSlot m
 render st =
   HH.div
   [ HP.id_ ( UUID.toString st.options.elemId ) ]
@@ -46,36 +50,24 @@ render st =
       [ HH.text "+" ]
     ]
   , HH.div
-    [ Common.css $ "datetimepicker-wraper" <> Common.displayModeToString st.options.displayMode ]
+    [ Common.css $ "datetimepicker-wrapper " <> Common.displayModeToString st.options.displayMode ]
     [ HH.div
-      [ Common.css $ "modal-background" <> Common.displayModeToString st.options.displayMode ]
+      [ Common.css $ "modal-background " <> st.options.isModal ]
       []
     , HH.div
-      [ Common.css "datetimepicker" ]
+      [ Common.css
+        $ "datetimepicker is-datetimepicker-default "
+        <> st.options.color
+        <> " "
+        <> Common.dropDownStateToString st.options.dropDownState
+      ]
       [ HH.div
-        [ Common.css $ "datetimepicker-container" <> Common.headerPosToString st.options.headerPosition ]
-        []
+        [ Common.css $ "datetimepicker-container " <> Common.headerPosToString st.options.headerPosition ]
+        [ HH.slot Header._header unit Header.component unit absurd ]
       ]
     ]
   ]
 
-handleAction :: forall action o m. action -> H.HalogenM State action () o m Unit
+handleAction :: forall action o m. action -> H.HalogenM State action ChildSlot o m Unit
 handleAction = const $ pure unit
 

src/Bulma/Header.purs

@@ -0,0 +1,107 @@
+module Bulma.Header where
+
+import Prelude
+import Data.Symbol ( SProxy(..) )
+-- Internal
+import Bulma.Common ( DateTimePickerSpec )
+import Bulma.Common as Common
+-- Halogen
+import Halogen as H
+import Halogen.HTML as HH
+
+type State =
+  { options :: DateTimePickerSpec
+  }
+
+type Slot slot = forall query. H.Slot query Void slot
+
+_header :: SProxy "header"
+_header = SProxy
+
+component :: forall q i o m. H.Component HH.HTML q i o m
+component =
+  H.mkComponent
+  { initialState: const { options: Common.defaultSpec }
+  , render
+  , eval: H.mkEval H.defaultEval
+  }
+
+render :: forall action m. State -> H.ComponentHTML action () m
+render st =
+  HH.div_
+  [ fromRangeElement st
+  ]
+
+fromRangeElement :: forall a action. State -> HH.HTML a action
+fromRangeElement st =
+  HH.div
+  [ Common.css $ "datetimepicker-header " <> Common.typeToString st.options.type_ ]
+  [ HH.div
+    [ Common.css "datetimepicker-selection-details" ]
+    [ HH.div
+      [ Common.css "datetimepicker-selection-from " ]
+      [ HH.text st.options.labelFrom ]
+    , HH.div
+      [ Common.css "datetimepicker-selection-start "]
+      [ HH.div
+        [ Common.css "datetimepicker-selection-wrapper" ]
+        [ HH.div
+          [ Common.css "datetimepicker-selection-day" ]
+          []
+        , HH.div
+          [ Common.css "datetimepicker-selection-date" ]
+          [ HH.div
+            [ Common.css "datetimepicker-selection-month" ]
+            []
+          , HH.div
+            [ Common.css "datetimepicker-selection-weekday" ]
+            [ timeElement ]
+          ]
+        ]
+      ]
+    ]
+  ]
+
+toRangeElement :: forall a action. HH.HTML a action
+toRangeElement =
+  HH.div
+  [ Common.css "datetimepicker-selection-details" ]
+  [ HH.div
+    [ Common.css "datetimepicker-selection-to " ]
+    []
+  , HH.div
+    [ Common.css "datetimepicker-selection-end" ]
+    [ HH.div
+      [ Common.css "datetimepicker-selection-wrapper" ]
+      [ HH.div
+        [ Common.css "datetimepicker-selection-day" ]
+        []
+      , HH.div
+        [ Common.css "datetimepicker-selection-date" ]
+        [ HH.div
+          [ Common.css "datetimepicker-selection-month"]
+          []
+        , HH.div
+          [ Common.css "datetimepicker-selection-weekday"]
+          [ timeElement ]
+        ]
+      ]
+    ]
+  ]
+
+timeElement :: forall a action. HH.HTML a action
+timeElement =
+  HH.div
+  [ Common.css "datetimepicker-selection-time" ]
+  [ HH.div
+    [ Common.css "datetimepicker-selection-time-icon" ]
+    [ HH.figure
+      [ Common.css "image 16x16" ]
+      [ HH.text ""
+      ]
+    ]
+  , HH.div
+    [ Common.css "datetimepicker-selection-hour" ]
+    []
+  ]
+

src/Bulma/SvgString.purs

@@ -0,0 +1,30 @@
+module Bulma.SvgString where
+
+import Prelude
+
+previousSvgString :: String
+previousSvgString =
+  "<svg viewBox=\"0 0 50 80\" xml:space=\"preserve\">" <>
+    "<polyline fill=\"none\" stroke-width=\".5em\" stroke-linecap=\"round\" stroke-linejoin=\"round\" points=\"45.63,75.8 0.375,38.087 45.63,0.375\" />" <>
+  "</svg>"
+
+nextSvgString :: String
+nextSvgString = "<svg viewBox=\"0 0 50 80\" xml:space=\"preserve\">"
+  <> "<polyline fill=\"none\" stroke-width=\".5em\" stroke-linecap=\"round\" stroke-linejoin=\"round\" points=\"0.375,0.375 45.63,38.087 0.375,75.8 \"/>"
+  <> "</svg>"
+
+timeSvgString :: String
+timeSvgString = "<svg version=\"1.1\" x=\"0px\" y=\"0px\" viewBox=\"0 0 60 60\" xml:space=\"preserve\">"
+  <> "<g>"
+  <> "<path fill=\"currentcolor\" d=\"M30,0C13.458,0,0,13.458,0,30s13.458,30,30,30s30-13.458,30-30S46.542,0,30,0z M30,58C14.561,58,2,45.439,2,30S14.561,2,30,2s28,12.561,28,28S45.439,58,30,58z\"/>"
+  <> "<path fill=\"currentcolor\" d=\"M30,6c-0.552,0-1,0.447-1,1v23H14c-0.552,0-1,0.447-1,1s0.448,1,1,1h16c0.552,0,1-0.447,1-1V7C31,6.447,30.552,6,30,6z\"/>"
+  <> "</g>"
+  <> "</svg>"
+
+dateSvgString :: String
+dateSvgString = "<svg version=\"1.1\" x=\"0px\" y=\"0px\" viewBox=\"0 0 60 60\" xml:space=\"preserve\">"
+  <> "<g>"
+  <> "<path d=\"M57,4h-7V1c0-0.553-0.447-1-1-1h-7c-0.553,0-1,0.447-1,1v3H19V1c0-0.553-0.447-1-1-1h-7c-0.553,0-1,0.447-1,1v3H3C2.447,4,2,4.447,2,5v11v43c0,0.553,0.447,1,1,1h54c0.553,0,1-0.447,1-1V16V5C58,4.447,57.553,4,57,4z M43,2h5v3v3h-5V5V2z M12,2h5v3v3h-5V5V2z M4,6h6v3c0,0.553,0.447,1,1,1h7c0.553,0,1-0.447,1-1V6h22v3c0,0.553,0.447,1,1,1h7c0.553,0,1-0.447,1-1V6h6v9H4V6zM4,58V17h52v41H4z\"/>"
+  <> "<path d=\"M38,23h-7h-2h-7h-2h-9v9v2v7v2v9h9h2h7h2h7h2h9v-9v-2v-7v-2v-9h-9H38z M31,25h7v7h-7V25z M38,41h-7v-7h7V41z M22,34h7v7h-7V34z M22,25h7v7h-7V25z M13,25h7v7h-7V25z M13,34h7v7h-7V34z M20,50h-7v-7h7V50z M29,50h-7v-7h7V50z M38,50h-7v-7h7V50z M47,50h-7v-7h7V50z M47,41h-7v-7h7V41z M47,25v7h-7v-7H47z\"/>"
+  <> "</g>"
+  <> "</svg>"