yogsototh/espial
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

upgrade to halogen v5.0.0-rc.1

Browse source
This commit is contained in:
Jon Schoning 2019-02-28 22:45:34 -06:00
parent 92e22e5be8
commit a44cd8e2b3
14 changed files with 195 additions and 227 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
espial.cabal
View file

@ -2,7 +2,7 @@
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 7227333703029085a8041c55bcc653a2b000338e12bb43813bf9b349cfab6a11 -- hash: c9ea5f2d822708beca3dc6ea7fdfd09698f9f2df05afb37ac16e204d89a528c2
name: espial name: espial
version: 0.0.8 version: 0.0.8
@ -95,6 +95,30 @@ flag library-only
default: False default: False
library library
exposed-modules:
Application
Foundation
Generic
Handler.AccountSettings
Handler.Add
Handler.Archive
Handler.Common
Handler.Docs
Handler.Edit
Handler.Home
Handler.Notes
Handler.User
Import
Import.NoFoundation
Model
ModelCustom
PathPiece
Pretty
Settings
Settings.StaticFiles
Types
other-modules:
Paths_espial
hs-source-dirs: hs-source-dirs:
src src
default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
@ -160,34 +184,13 @@ library
cpp-options: -DDEVELOPMENT cpp-options: -DDEVELOPMENT
else else
ghc-options: -Wall -fwarn-tabs -O2 ghc-options: -Wall -fwarn-tabs -O2
exposed-modules:
Application
Foundation
Generic
Handler.AccountSettings
Handler.Add
Handler.Archive
Handler.Common
Handler.Docs
Handler.Edit
Handler.Home
Handler.Notes
Handler.User
Import
Import.NoFoundation
Model
ModelCustom
PathPiece
Pretty
Settings
Settings.StaticFiles
Types
other-modules:
Paths_espial
default-language: Haskell2010 default-language: Haskell2010
executable espial executable espial
main-is: main.hs main-is: main.hs
other-modules:
DevelMain
Paths_espial
hs-source-dirs: hs-source-dirs:
app app
default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
@ -252,13 +255,12 @@ executable espial
, yesod-static >=1.6 && <1.7 , yesod-static >=1.6 && <1.7
if flag(library-only) if flag(library-only)
buildable: False buildable: False
other-modules:
DevelMain
Paths_espial
default-language: Haskell2010 default-language: Haskell2010
executable migration executable migration
main-is: Main.hs main-is: Main.hs
other-modules:
Paths_espial
hs-source-dirs: hs-source-dirs:
app/migration app/migration
default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
@ -324,13 +326,16 @@ executable migration
, yesod-static >=1.6 && <1.7 , yesod-static >=1.6 && <1.7
if flag(library-only) if flag(library-only)
buildable: False buildable: False
other-modules:
Paths_espial
default-language: Haskell2010 default-language: Haskell2010
test-suite test test-suite test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Spec.hs main-is: Spec.hs
other-modules:
Handler.CommonSpec
Handler.HomeSpec
TestImport
Paths_espial
hs-source-dirs: hs-source-dirs:
test test
default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
@ -395,9 +400,4 @@ test-suite test
, yesod-form >=1.6 && <1.7 , yesod-form >=1.6 && <1.7
, yesod-static >=1.6 && <1.7 , yesod-static >=1.6 && <1.7
, yesod-test , yesod-test
other-modules:
Handler.CommonSpec
Handler.HomeSpec
TestImport
Paths_espial
default-language: Haskell2010 default-language: Haskell2010

13
purs/packages.dhall
View file

@ -1,11 +1,16 @@
let mkPackage = let mkPackage =
https://raw.githubusercontent.com/spacchetti/spacchetti/0.12.3-20190226/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 https://raw.githubusercontent.com/spacchetti/spacchetti/0.12.3-20190226/src/mkPackage.dhall
let upstream = let upstream =
https://raw.githubusercontent.com/spacchetti/spacchetti/0.12.3-20190226/src/packages.dhall sha256:832321319d21051fe1c0ff21bcee77af1f86bf7700d2041e1e1c1ac6b1dc4ea1 https://raw.githubusercontent.com/spacchetti/spacchetti/0.12.3-20190226/src/packages.dhall
let overrides = {=} let overrides =
{ halogen =
upstream.halogen ⫽ { version = "v5.0.0-rc.1" }
, halogen-vdom =
upstream.halogen-vdom ⫽ { version = "v5.1.0" }
}
let additions = {=} let additions = {=}
in upstream ⫽ overrides ⫽ additions in upstream ⫽ overrides ⫽ additions

28
purs/src/Component/AccountSettings.purs
View file

@ -11,7 +11,6 @@ import Halogen as H
import Halogen.HTML (HTML, div, input, text) import Halogen.HTML (HTML, div, input, text)
import Halogen.HTML.Elements (label) import Halogen.HTML.Elements (label)
import Halogen.HTML.Events (onChecked) import Halogen.HTML.Events (onChecked)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (InputType(..), checked, for, id_, name, type_) import Halogen.HTML.Properties (InputType(..), checked, for, id_, name, type_)
import Model (AccountSettings) import Model (AccountSettings)
import Util (class_) import Util (class_)
@ -24,9 +23,9 @@ type UState =
_us :: Lens' UState AccountSettings _us :: Lens' UState AccountSettings
_us = lens _.us (_ { us = _ }) _us = lens _.us (_ { us = _ })
data UQuery a data UAction
= UEditField EditField a = UEditField EditField
| USubmit Event a | USubmit Event
data EditField data EditField
= EarchiveDefault Boolean = EarchiveDefault Boolean
@ -35,13 +34,12 @@ data EditField
-- | The bookmark component definition. -- | The bookmark component definition.
usetting :: AccountSettings -> H.Component HTML UQuery Unit Unit Aff usetting :: forall q i o. AccountSettings -> H.Component HTML q i o Aff
usetting u' = usetting u' =
H.component H.mkComponent
{ initialState: const (mkState u') { initialState: const (mkState u')
, render , render
, eval , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
, receiver: const Nothing
} }
where where
app = app' unit app = app' unit
@ -50,7 +48,7 @@ usetting u' =
{ us: u { us: u
} }
render :: UState -> H.ComponentHTML UQuery render :: forall m. UState -> H.ComponentHTML UAction () m
render { us } = render { us } =
div [ class_ "settings-form" ] div [ class_ "settings-form" ]
[ div [ class_ "fw7 mb2"] [ text "Account Settings" ] [ div [ class_ "fw7 mb2"] [ text "Account Settings" ]
@ -74,18 +72,16 @@ usetting u' =
] ]
] ]
where where
editField :: forall a. (a -> EditField) -> a -> Maybe (UQuery Unit) editField :: forall a. (a -> EditField) -> a -> Maybe UAction
editField f = HE.input UEditField <<< f editField f = Just <<< UEditField <<< f
eval :: UQuery ~> H.ComponentDSL UState UQuery Unit Aff handleAction :: UAction -> H.HalogenM UState UAction () o Aff Unit
eval (UEditField f next) = do handleAction (UEditField f) = do
_us %= case f of _us %= case f of
EarchiveDefault e -> _ { archiveDefault = e } EarchiveDefault e -> _ { archiveDefault = e }
EprivateDefault e -> _ { privateDefault = e } EprivateDefault e -> _ { privateDefault = e }
EprivacyLock e -> _ { privacyLock = e } EprivacyLock e -> _ { privacyLock = e }
pure next
eval (USubmit e next) = do handleAction (USubmit e) = do
us <- use _us us <- use _us
void $ H.liftAff (editAccountSettings us) void $ H.liftAff (editAccountSettings us)
pure next

46
purs/src/Component/Add.purs
View file

@ -17,7 +17,6 @@ import Globals (app', closeWindow, mmoment8601)
import Halogen as H import Halogen as H
import Halogen.HTML (HTML, br_, button, div, div_, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_) import Halogen.HTML (HTML, br_, button, div, div_, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_)
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick) import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (autofocus, ButtonType(..), InputType(..), autocomplete, checked, for, id_, name, required, rows, title, type_, value) import Halogen.HTML.Properties (autofocus, ButtonType(..), InputType(..), autocomplete, checked, for, id_, name, required, rows, title, type_, value)
import Model (Bookmark) import Model (Bookmark)
import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_) import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_)
@ -25,11 +24,11 @@ import Web.Event.Event (Event, preventDefault)
import Web.HTML (window) import Web.HTML (window)
import Web.HTML.Location (setHref) import Web.HTML.Location (setHref)
data BQuery a data BAction
= BEditField EditField a = BEditField EditField
| BEditSubmit Event a | BEditSubmit Event
| BDeleteAsk Boolean a | BDeleteAsk Boolean
| BDestroy a | BDestroy
data EditField data EditField
= Eurl String = Eurl String
@ -52,13 +51,12 @@ _bm = lens _.bm (_ { bm = _ })
_edit_bm :: Lens' BState Bookmark _edit_bm :: Lens' BState Bookmark
_edit_bm = lens _.edit_bm (_ { edit_bm = _ }) _edit_bm = lens _.edit_bm (_ { edit_bm = _ })
addbmark :: Bookmark -> H.Component HTML BQuery Unit Unit Aff addbmark :: forall q i o. Bookmark -> H.Component HTML q i o Aff
addbmark b' = addbmark b' =
H.component H.mkComponent
{ initialState: const (mkState b') { initialState: const (mkState b')
, render , render
, eval , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
, receiver: const Nothing
} }
where where
app = app' unit app = app' unit
@ -70,12 +68,12 @@ addbmark b' =
, destroyed: false , destroyed: false
} }
render :: BState -> H.ComponentHTML BQuery render :: forall m. BState -> H.ComponentHTML BAction () m
render s@{ bm, edit_bm } = render s@{ bm, edit_bm } =
div_ [ if not s.destroyed then display_edit else display_destroyed ] div_ [ if not s.destroyed then display_edit else display_destroyed ]
where where
display_edit = display_edit =
form [ onSubmit (HE.input BEditSubmit) ] form [ onSubmit (Just <<< BEditSubmit) ]
[ table [ class_ "w-100" ] [ table [ class_ "w-100" ]
[ tbody_ [ tbody_
[ tr_ [ tr_
@ -128,10 +126,10 @@ addbmark b' =
[ text (maybe " " fst mmoment) ] [ text (maybe " " fst mmoment) ]
, div [ class_ "edit_links dib ml1" ] , div [ class_ "edit_links dib ml1" ]
[ div [ class_ "delete_link di" ] [ div [ class_ "delete_link di" ]
[ button ([ type_ ButtonButton, onClick (HE.input_ (BDeleteAsk true)), class_ "delete" ] <> guard s.deleteAsk [ attr "hidden" "hidden" ]) [ text "delete" ] [ button ([ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk true), class_ "delete" ] <> guard s.deleteAsk [ attr "hidden" "hidden" ]) [ text "delete" ]
, span ([ class_ "confirm red" ] <> guard (not s.deleteAsk) [ attr "hidden" "hidden" ]) , span ([ class_ "confirm red" ] <> guard (not s.deleteAsk) [ attr "hidden" "hidden" ])
[ button [ type_ ButtonButton, onClick (HE.input_ (BDeleteAsk false))] [ text "cancel / " ] [ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk false)] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick (HE.input_ BDestroy), class_ "red" ] [ text "destroy" ] , button [ type_ ButtonButton, onClick \_ -> Just BDestroy, class_ "red" ] [ text "destroy" ]
] ]
] ]
] ]
@ -139,24 +137,22 @@ addbmark b' =
display_destroyed = p [ class_ "red"] [text "you killed this bookmark"] display_destroyed = p [ class_ "red"] [text "you killed this bookmark"]
editField :: forall a. (a -> EditField) -> a -> Maybe (BQuery Unit) editField :: forall a. (a -> EditField) -> a -> Maybe BAction
editField f = HE.input BEditField <<< f editField f = Just <<< BEditField <<< f
mmoment = mmoment8601 bm.time mmoment = mmoment8601 bm.time
toTextarea = toTextarea =
drop 1 drop 1
<<< foldMap (\x -> [br_, text x]) <<< foldMap (\x -> [br_, text x])
<<< S.split (Pattern "\n") <<< S.split (Pattern "\n")
eval :: BQuery ~> H.ComponentDSL BState BQuery Unit Aff handleAction :: BAction -> H.HalogenM BState BAction () o Aff Unit
eval (BDeleteAsk e next) = do handleAction (BDeleteAsk e) = do
H.modify_ (_ { deleteAsk = e }) H.modify_ (_ { deleteAsk = e })
pure next handleAction (BDestroy) = do
eval (BDestroy next) = do
bid <- H.gets _.bm.bid bid <- H.gets _.bm.bid
void $ H.liftAff (destroy bid) void $ H.liftAff (destroy bid)
H.modify_ (_ { destroyed = true }) H.modify_ (_ { destroyed = true })
pure next handleAction (BEditField f) = do
eval (BEditField f next) = do
_edit_bm %= case f of _edit_bm %= case f of
Eurl e -> _ { url = e } Eurl e -> _ { url = e }
Etitle e -> _ { title = e } Etitle e -> _ { title = e }
@ -164,8 +160,7 @@ addbmark b' =
Etags e -> _ { tags = e } Etags e -> _ { tags = e }
Eprivate e -> _ { private = e } Eprivate e -> _ { private = e }
Etoread e -> _ { toread = e } Etoread e -> _ { toread = e }
pure next handleAction (BEditSubmit e) = do
eval (BEditSubmit e next) = do
H.liftEffect (preventDefault e) H.liftEffect (preventDefault e)
edit_bm <- use _edit_bm edit_bm <- use _edit_bm
void $ H.liftAff (editBookmark edit_bm) void $ H.liftAff (editBookmark edit_bm)
@ -176,4 +171,3 @@ addbmark b' =
case _lookupQueryStringValue qs "next" of case _lookupQueryStringValue qs "next" of
Just n -> liftEffect (setHref n loc) Just n -> liftEffect (setHref n loc)
_ -> liftEffect (closeWindow win) _ -> liftEffect (closeWindow win)
pure next

43
purs/src/Component/BList.purs
View file

@ -2,7 +2,7 @@ module Component.BList where
import Prelude import Prelude
import Component.BMark (BMessage(..), BQuery, bmark) import Component.BMark (BMessage(..), BSlot, bmark)
import Model (Bookmark, BookmarkId) import Model (Bookmark, BookmarkId)
import Data.Array (filter) import Data.Array (filter)
@ -10,39 +10,30 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
import Halogen.HTML.Events as HE import Data.Symbol (SProxy(..))
type BSlot = BookmarkId data LAction =
HandleBMessage BookmarkId BMessage
data LQuery a = type ChildSlots =
HandleBMessage BSlot BMessage a ( bookmark :: BSlot Int
)
blist :: Array Bookmark -> H.Component HH.HTML LQuery Unit Void Aff _bookmark = SProxy :: SProxy "bookmark"
blist :: forall q i o. Array Bookmark -> H.Component HH.HTML q i o Aff
blist st = blist st =
H.parentComponent H.mkComponent
{ initialState: const st { initialState: const st
, render , render
, eval , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
, receiver: const Nothing
} }
where where
render :: Array Bookmark -> H.ParentHTML LQuery BQuery BSlot Aff render :: Array Bookmark -> H.ComponentHTML LAction ChildSlots Aff
render bms = render bms =
HH.div_ (map renderBookmark bms) HH.div_ $ map (\b -> HH.slot _bookmark b.bid (bmark b) unit (Just <<< HandleBMessage b.bid)) bms
where
renderBookmark :: Bookmark -> H.ParentHTML LQuery BQuery BSlot Aff
renderBookmark b =
HH.slot
b.bid
(bmark b)
unit
(HE.input (HandleBMessage b.bid))
eval :: LQuery ~> H.ParentDSL (Array Bookmark) LQuery BQuery BSlot Void Aff handleAction :: LAction -> H.HalogenM (Array Bookmark) LAction ChildSlots o Aff Unit
eval (HandleBMessage p BNotifyRemove next) = do handleAction (HandleBMessage bid BNotifyRemove) = do
H.modify_ (removeBookmark p) H.modify_ (filter (\b -> b.bid /= bid))
pure next
where
removeBookmark :: BookmarkId -> Array Bookmark -> Array Bookmark
removeBookmark bookmarkId = filter (\b -> b.bid /= bookmarkId)

72
purs/src/Component/BMark.purs
View file

@ -16,21 +16,21 @@ import Globals (app', mmoment8601)
import Halogen as H import Halogen as H
import Halogen.HTML (HTML, a, br_, button, div, div_, form, input, label, span, text, textarea) import Halogen.HTML (HTML, a, br_, button, div, div_, form, input, label, span, text, textarea)
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick) import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, checked, for, href, id_, name, required, rows, target, title, type_, value) import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, checked, for, href, id_, name, required, rows, target, title, type_, value)
import Model (Bookmark) import Model (Bookmark)
import Util (class_, attr, fromNullableStr) import Util (class_, attr, fromNullableStr)
import Web.Event.Event (Event, preventDefault) import Web.Event.Event (Event, preventDefault)
import Data.Const (Const)
-- | UI Events -- | UI Events
data BQuery a data BAction
= BStar Boolean a = BStar Boolean
| BDeleteAsk Boolean a | BDeleteAsk Boolean
| BDestroy a | BDestroy
| BEdit Boolean a | BEdit Boolean
| BEditField EditField a | BEditField EditField
| BEditSubmit Event a | BEditSubmit Event
| BMarkRead a | BMarkRead
-- | FormField Edits -- | FormField Edits
data EditField data EditField
@ -45,6 +45,8 @@ data EditField
data BMessage data BMessage
= BNotifyRemove = BNotifyRemove
type BSlot = H.Slot (Const Void) BMessage
type BState = type BState =
{ bm :: Bookmark { bm :: Bookmark
, edit_bm :: Bookmark , edit_bm :: Bookmark
@ -61,13 +63,12 @@ _edit_bm = lens _.edit_bm (_ { edit_bm = _ })
_edit :: Lens' BState Boolean _edit :: Lens' BState Boolean
_edit = lens _.edit (_ { edit = _ }) _edit = lens _.edit (_ { edit = _ })
bmark :: Bookmark -> H.Component HTML BQuery Unit BMessage Aff bmark :: forall q i. Bookmark -> H.Component HTML q i BMessage Aff
bmark b' = bmark b' =
H.component H.mkComponent
{ initialState: const (mkState b') { initialState: const (mkState b')
, render , render
, eval , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
, receiver: const Nothing
} }
where where
app = app' unit app = app' unit
@ -79,7 +80,7 @@ bmark b' =
, edit: false , edit: false
} }
render :: BState -> H.ComponentHTML BQuery render :: forall m. BState -> H.ComponentHTML BAction () m
render s@{ bm, edit_bm } = render s@{ bm, edit_bm } =
div [ id_ (show bm.bid) , class_ ("bookmark w-100 mw7 pa1 mb3" <> guard bm.private " private")] $ div [ id_ (show bm.bid) , class_ ("bookmark w-100 mw7 pa1 mb3" <> guard bm.private " private")] $
star <> star <>
@ -91,7 +92,7 @@ bmark b' =
star = star =
guard app.dat.isowner guard app.dat.isowner
[ div [ class_ ("star fl pointer" <> guard bm.selected " selected") ] [ div [ class_ ("star fl pointer" <> guard bm.selected " selected") ]
[ button [ class_ "moon-gray", onClick (HE.input_ (BStar (not bm.selected))) ] [ text "✭" ] ] [ button [ class_ "moon-gray", onClick \_ -> Just (BStar (not bm.selected)) ] [ text "✭" ] ]
] ]
display = display =
@ -121,7 +122,7 @@ bmark b' =
display_edit = display_edit =
[ div [ class_ "edit_bookmark_form pa2 pt0 bg-white" ] $ [ div [ class_ "edit_bookmark_form pa2 pt0 bg-white" ] $
[ form [ onSubmit (HE.input BEditSubmit) ] [ form [ onSubmit (Just <<< BEditSubmit) ]
[ div_ [ text "url" ] [ div_ [ text "url" ]
, input [ type_ InputUrl , class_ "url w-100 mb2 pt1 f7 edit_form_input" , required true , name "url" , input [ type_ InputUrl , class_ "url w-100 mb2 pt1 f7 edit_form_input" , required true , name "url"
, value (edit_bm.url) , onValueChange (editField Eurl) ] , value (edit_bm.url) , onValueChange (editField Eurl) ]
@ -156,7 +157,7 @@ bmark b' =
, input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ] , input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ]
, text " " , text " "
, input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel" , input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel"
, onClick (HE.input_ (BEdit false)) ] , onClick \_ -> Just (BEdit false) ]
] ]
] ]
] ]
@ -164,24 +165,24 @@ bmark b' =
links = links =
guard app.dat.isowner guard app.dat.isowner
[ div [ class_ "edit_links di" ] [ div [ class_ "edit_links di" ]
[ button [ type_ ButtonButton, onClick (HE.input_ (BEdit true)), class_ "edit light-silver hover-blue" ] [ text "edit  " ] [ button [ type_ ButtonButton, onClick \_ -> Just (BEdit true), class_ "edit light-silver hover-blue" ] [ text "edit  " ]
, div [ class_ "delete_link di" ] , div [ class_ "delete_link di" ]
[ button [ type_ ButtonButton, onClick (HE.input_ (BDeleteAsk true)), class_ ("delete light-silver hover-blue" <> guard s.deleteAsk " dn") ] [ text "delete" ] [ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk true), class_ ("delete light-silver hover-blue" <> guard s.deleteAsk " dn") ] [ text "delete" ]
, span ([ class_ ("confirm red" <> guard (not s.deleteAsk) " dn") ] ) , span ([ class_ ("confirm red" <> guard (not s.deleteAsk) " dn") ] )
[ button [ type_ ButtonButton, onClick (HE.input_ (BDeleteAsk false))] [ text "cancel / " ] [ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk false)] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick (HE.input_ BDestroy), class_ "red" ] [ text "destroy" ] , button [ type_ ButtonButton, onClick \_ -> Just BDestroy, class_ "red" ] [ text "destroy" ]
] ]
] ]
] ]
, div [ class_ "read di" ] $ , div [ class_ "read di" ] $
guard bm.toread guard bm.toread
[ text "  " [ text "  "
, button [ onClick (HE.input_ BMarkRead), class_ "mark_read" ] [ text "mark as read"] , button [ onClick \_ -> Just BMarkRead, class_ "mark_read" ] [ text "mark as read"]
] ]
] ]
editField :: forall a. (a -> EditField) -> a -> Maybe (BQuery Unit) editField :: forall a. (a -> EditField) -> a -> Maybe BAction
editField f = HE.input BEditField <<< f editField f = Just <<< BEditField <<< f
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
mmoment = mmoment8601 bm.time mmoment = mmoment8601 bm.time
@ -190,44 +191,39 @@ bmark b' =
# foldMap (\x -> [br_, text x]) # foldMap (\x -> [br_, text x])
# drop 1 # drop 1
eval :: BQuery ~> H.ComponentDSL BState BQuery BMessage Aff handleAction :: BAction -> H.HalogenM BState BAction () BMessage Aff Unit
-- | Star -- | Star
eval (BStar e next) = do handleAction (BStar e) = do
bm <- use _bm bm <- use _bm
H.liftAff (toggleStar bm.bid (if e then Star else UnStar)) H.liftAff (toggleStar bm.bid (if e then Star else UnStar))
_bm %= _ { selected = e } _bm %= _ { selected = e }
_edit_bm %= _ { selected = e } _edit_bm %= _ { selected = e }
pure next
-- | Delete -- | Delete
eval (BDeleteAsk e next) = do handleAction (BDeleteAsk e) = do
H.modify_ (_ { deleteAsk = e }) H.modify_ (_ { deleteAsk = e })
pure next
-- | Destroy -- | Destroy
eval (BDestroy next) = do handleAction (BDestroy) = do
bm <- use _bm bm <- use _bm
void $ H.liftAff (destroy bm.bid) void $ H.liftAff (destroy bm.bid)
H.raise BNotifyRemove H.raise BNotifyRemove
pure next
-- | Mark Read -- | Mark Read
eval (BMarkRead next) = do handleAction (BMarkRead) = do
bm <- use _bm bm <- use _bm
void (H.liftAff (markRead bm.bid)) void (H.liftAff (markRead bm.bid))
_bm %= _ { toread = false } _bm %= _ { toread = false }
pure next
-- | Start/Stop Editing -- | Start/Stop Editing
eval (BEdit e next) = do handleAction (BEdit e) = do
bm <- use _bm bm <- use _bm
_edit_bm .= bm _edit_bm .= bm
_edit .= e _edit .= e
pure next
-- | Update Form Field -- | Update Form Field
eval (BEditField f next) = do handleAction (BEditField f) = do
_edit_bm %= case f of _edit_bm %= case f of
Eurl e -> _ { url = e } Eurl e -> _ { url = e }
Etitle e -> _ { title = e } Etitle e -> _ { title = e }
@ -235,13 +231,11 @@ bmark b' =
Etags e -> _ { tags = e } Etags e -> _ { tags = e }
Eprivate e -> _ { private = e } Eprivate e -> _ { private = e }
Etoread e -> _ { toread = e } Etoread e -> _ { toread = e }
pure next
-- | Submit -- | Submit
eval (BEditSubmit e next) = do handleAction (BEditSubmit e) = do
H.liftEffect (preventDefault e) H.liftEffect (preventDefault e)
edit_bm <- use _edit_bm edit_bm <- use _edit_bm
void $ H.liftAff (editBookmark edit_bm) void $ H.liftAff (editBookmark edit_bm)
_bm .= edit_bm _bm .= edit_bm
_edit .= false _edit .= false
pure next

9
purs/src/Component/Markdown.purs
View file

@ -1,15 +1,10 @@
module Component.Markdown (component, MInput, MQuery, MOutput, module RHExt) where module Component.Markdown (component) where
import Component.RawHtml as RH import Component.RawHtml as RH
import Component.RawHtml (Query(Receive)) as RHExt
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Foreign.Marked (marked) import Foreign.Marked (marked)
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
type MInput = String component :: forall q o. H.Component HH.HTML q String o Aff
type MQuery = RH.Query String
type MOutput = RH.Output
component :: H.Component HH.HTML MQuery MInput MOutput Aff
component = RH.mkComponent marked component = RH.mkComponent marked

22
purs/src/Component/NList.purs
View file

@ -16,26 +16,23 @@ import Halogen.HTML.Properties (href, id_, title)
import Model (Note, NoteSlug) import Model (Note, NoteSlug)
import Util (class_, fromNullableStr) import Util (class_, fromNullableStr)
data NLQuery a data NLAction
= NLNop a = NLNop
type NLSlot = NoteSlug
type NLState = type NLState =
{ notes :: Array Note { notes :: Array Note
, cur :: Maybe NLSlot , cur :: Maybe NoteSlug
, deleteAsk:: Boolean , deleteAsk:: Boolean
, edit :: Boolean , edit :: Boolean
} }
nlist :: Array Note -> H.Component HH.HTML NLQuery Unit Void Aff nlist :: forall q i o. Array Note -> H.Component HH.HTML q i o Aff
nlist st' = nlist st' =
H.component H.mkComponent
{ initialState: const (mkState st') { initialState: const (mkState st')
, render , render
, eval , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
, receiver: const Nothing
} }
where where
app = app' unit app = app' unit
@ -47,11 +44,10 @@ nlist st' =
, edit: false , edit: false
} }
render :: NLState -> H.ComponentHTML NLQuery render :: NLState -> H.ComponentHTML NLAction () Aff
render st@{ notes } = render st@{ notes } =
HH.div_ (map renderNote notes) HH.div_ (map renderNote notes)
where where
renderNote :: Note -> H.ComponentHTML NLQuery
renderNote bm = renderNote bm =
div [ id_ (show bm.id) , class_ ("note w-100 mw7 pa1 mb2")] $ div [ id_ (show bm.id) , class_ ("note w-100 mw7 pa1 mb2")] $
[ div [ class_ "display" ] $ [ div [ class_ "display" ] $
@ -71,5 +67,5 @@ nlist st' =
# foldMap (\x -> [br_, text x]) # foldMap (\x -> [br_, text x])
# drop 1 # drop 1
eval :: NLQuery ~> H.ComponentDSL NLState NLQuery Void Aff handleAction :: NLAction -> H.HalogenM NLState NLAction () o Aff Unit
eval (NLNop next) = pure next handleAction NLNop = pure unit

71
purs/src/Component/NNote.purs
View file

@ -19,20 +19,21 @@ import Halogen as H
import Halogen.HTML (br_, button, div, form, input, label, p, span, text, textarea) import Halogen.HTML (br_, button, div, form, input, label, p, span, text, textarea)
import Halogen.HTML as HH import Halogen.HTML as HH
import Halogen.HTML.Events (onChecked, onClick, onSubmit, onValueChange) import Halogen.HTML.Events (onChecked, onClick, onSubmit, onValueChange)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (ButtonType(..), InputType(..), checked, for, id_, name, rows, title, type_, value) import Halogen.HTML.Properties (ButtonType(..), InputType(..), checked, for, id_, name, rows, title, type_, value)
import Model (Note) import Model (Note)
import Util (_loc, class_, fromNullableStr) import Util (_loc, class_, fromNullableStr)
import Web.Event.Event (Event, preventDefault) import Web.Event.Event (Event, preventDefault)
import Web.HTML.Location (setHref) import Web.HTML.Location (setHref)
import Data.Symbol (SProxy(..))
import Data.Const (Const)
data NQuery a data NAction
= NNop a = NNop
| NEditField EditField a | NEditField EditField
| NEditSubmit Event a | NEditSubmit Event
| NEdit Boolean a | NEdit Boolean
| NDeleteAsk Boolean a | NDeleteAsk Boolean
| NDestroy a | NDestroy
type NState = type NState =
{ note :: Note { note :: Note
@ -57,15 +58,18 @@ data EditField
| Etext String | Etext String
| EisMarkdown Boolean | EisMarkdown Boolean
type NChildQuery = Markdown.MQuery _markdown = SProxy :: SProxy "markdown"
nnote :: Note -> H.Component HH.HTML NQuery Unit Void Aff type ChildSlots =
( markdown :: H.Slot (Const Void) Void Unit
)
nnote :: forall q i o. Note -> H.Component HH.HTML q i o Aff
nnote st' = nnote st' =
H.parentComponent H.mkComponent
{ initialState: const (mkState st') { initialState: const (mkState st')
, render , render
, eval , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
, receiver: const Nothing
} }
where where
app = app' unit app = app' unit
@ -78,7 +82,7 @@ nnote st' =
, destroyed: false , destroyed: false
} }
render :: NState -> H.ParentHTML NQuery NChildQuery Unit Aff render :: NState -> H.ComponentHTML NAction ChildSlots Aff
render st@{ note, edit_note } = render st@{ note, edit_note } =
if st.destroyed if st.destroyed
then display_destroyed then display_destroyed
@ -95,7 +99,7 @@ nnote st' =
[ text $ if S.null note.title then "[no title]" else note.title ] [ text $ if S.null note.title then "[no title]" else note.title ]
, br_ , br_
, if note.isMarkdown , if note.isMarkdown
then div [ class_ "description mt1" ] [ HH.slot unit Markdown.component note.text absurd ] then div [ class_ "description mt1" ] [ HH.slot _markdown unit Markdown.component note.text absurd ]
else div [ class_ "description mt1 mid-gray" ] (toTextarea note.text) else div [ class_ "description mt1 mid-gray" ] (toTextarea note.text)
, div [ class_ "link f7 dib gray w4", title (maybe note.created snd (mmoment note)) ] , div [ class_ "link f7 dib gray w4", title (maybe note.created snd (mmoment note)) ]
[ text (maybe " " fst (mmoment note)) ] [ text (maybe " " fst (mmoment note)) ]
@ -103,19 +107,19 @@ nnote st' =
] ]
<> -- | Render Action Links <> -- | Render Action Links
[ div [ class_ "edit_links db mt3" ] [ div [ class_ "edit_links db mt3" ]
[ button [ type_ ButtonButton, onClick (HE.input_ (NEdit true)), class_ "edit light-silver hover-blue" ] [ text "edit  " ] [ button [ type_ ButtonButton, onClick \_ -> Just (NEdit true), class_ "edit light-silver hover-blue" ] [ text "edit  " ]
, div [ class_ "delete_link di" ] , div [ class_ "delete_link di" ]
[ button [ type_ ButtonButton, onClick (HE.input_ (NDeleteAsk true)), class_ ("delete light-silver hover-blue" <> guard st.deleteAsk " dn") ] [ text "delete" ] [ button [ type_ ButtonButton, onClick \_ -> Just (NDeleteAsk true), class_ ("delete light-silver hover-blue" <> guard st.deleteAsk " dn") ] [ text "delete" ]
, span ([ class_ ("confirm red" <> guard (not st.deleteAsk) " dn") ] ) , span ([ class_ ("confirm red" <> guard (not st.deleteAsk) " dn") ] )
[ button [ type_ ButtonButton, onClick (HE.input_ (NDeleteAsk false))] [ text "cancel / " ] [ button [ type_ ButtonButton, onClick \_ -> Just (NDeleteAsk false)] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick (HE.input_ NDestroy), class_ "red" ] [ text "destroy" ] , button [ type_ ButtonButton, onClick \_ -> Just NDestroy, class_ "red" ] [ text "destroy" ]
] ]
] ]
] ]
] ]
renderNote_edit = renderNote_edit =
form [ onSubmit (HE.input NEditSubmit) ] form [ onSubmit (Just <<< NEditSubmit) ]
[ p [ class_ "mt2 mb1"] [ text "title:" ] [ p [ class_ "mt2 mb1"] [ text "title:" ]
, input [ type_ InputText , class_ "title w-100 mb1 pt1 f7 edit_form_input" , name "title" , input [ type_ InputText , class_ "title w-100 mb1 pt1 f7 edit_form_input" , name "title"
, value (edit_note.title) , onValueChange (editField Etitle) , value (edit_note.title) , onValueChange (editField Etitle)
@ -135,58 +139,54 @@ nnote st' =
, input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ] , input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ]
, text " " , text " "
, input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel" , input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel"
, onClick (HE.input_ (NEdit false)) , onClick \_ -> Just (NEdit false)
] ]
] ]
display_destroyed = p [ class_ "red"] [text "you killed this note"] display_destroyed = p [ class_ "red"] [text "you killed this note"]
mmoment n = mmoment8601 n.created mmoment n = mmoment8601 n.created
editField :: forall a. (a -> EditField) -> a -> Maybe (NQuery Unit) editField :: forall a. (a -> EditField) -> a -> Maybe NAction
editField f = HE.input NEditField <<< f editField f = Just <<< NEditField <<< f
toTextarea input = toTextarea input =
S.split (Pattern "\n") input S.split (Pattern "\n") input
# foldMap (\x -> [br_, text x]) # foldMap (\x -> [br_, text x])
# drop 1 # drop 1
eval :: NQuery ~> H.ParentDSL NState NQuery NChildQuery Unit Void Aff handleAction :: NAction -> H.HalogenM NState NAction ChildSlots o Aff Unit
eval (NNop next) = pure next handleAction (NNop) = pure unit
-- | EditField -- | EditField
eval (NEditField f next) = do handleAction (NEditField f) = do
_edit_note %= case f of _edit_note %= case f of
Etitle e -> _ { title = e } Etitle e -> _ { title = e }
Etext e -> _ { text = e } Etext e -> _ { text = e }
EisMarkdown e -> _ { isMarkdown = e } EisMarkdown e -> _ { isMarkdown = e }
pure next
-- | Delete -- | Delete
eval (NDeleteAsk e next) = do handleAction (NDeleteAsk e) = do
H.modify_ (_ { deleteAsk = e }) H.modify_ (_ { deleteAsk = e })
pure next
-- | Destroy -- | Destroy
eval (NDestroy next) = do handleAction (NDestroy) = do
note <- use _note note <- use _note
void $ H.liftAff (destroyNote note.id) void $ H.liftAff (destroyNote note.id)
H.modify_ (_ { destroyed = true }) H.modify_ (_ { destroyed = true })
pure next
-- | Start/Stop Editing -- | Start/Stop Editing
eval (NEdit e next) = do handleAction (NEdit e) = do
note <- use _note note <- use _note
_edit_note .= note _edit_note .= note
_edit .= e _edit .= e
pure next
-- | Submit -- | Submit
eval (NEditSubmit e next) = do handleAction (NEditSubmit e) = do
H.liftEffect (preventDefault e) H.liftEffect (preventDefault e)
edit_note <- use _edit_note edit_note <- use _edit_note
res <- H.liftAff (editNote edit_note) res <- H.liftAff (editNote edit_note)
case res.body of case res.body of
Left err -> pure next Left err -> pure unit
Right r -> do Right r -> do
if (edit_note.id == 0) if (edit_note.id == 0)
then do then do
@ -194,4 +194,3 @@ nnote st' =
else do else do
_note .= edit_note _note .= edit_note
_edit .= false _edit .= false
pure next

44
purs/src/Component/RawHtml.purs
View file

@ -9,54 +9,52 @@ import Effect.Aff (Aff)
import Globals (RawHTML(..)) import Globals (RawHTML(..))
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP import Halogen.HTML.Properties as HP
import Web.HTML (HTMLElement) import Web.HTML (HTMLElement)
foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit
data Query i a data Action i
= SetInnerHTML a = SetInnerHTML
| Receive (Input i) a | Receive (Input i)
type Input i = i type Input i = i
type Output = Void
type State i = type State i =
{ elRef :: H.RefLabel { elRef :: H.RefLabel
, inputval :: Input i , inputval :: Input i
} }
component :: H.Component HH.HTML (Query String) (Input String) Output Aff component :: forall q o. H.Component HH.HTML q (Input String) o Aff
component = mkComponent RawHTML component = mkComponent RawHTML
mkComponent :: forall i. (Input i -> RawHTML) -> H.Component HH.HTML (Query i) (Input i) Output Aff mkComponent :: forall q i o. (Input i -> RawHTML) -> H.Component HH.HTML q (Input i) o Aff
mkComponent toRawHTML = H.lifecycleComponent mkComponent toRawHTML =
{ initialState: \inputval -> { elRef: H.RefLabel "inputval", inputval } H.mkComponent
, render { initialState: \inputval -> { elRef: H.RefLabel "inputval", inputval }
, eval , render
, receiver: HE.input Receive , eval: H.mkEval (H.defaultEval { handleAction = handleAction
, initializer: Just $ H.action SetInnerHTML , initialize = Just SetInnerHTML
, finalizer: Nothing , receive = Just <<< Receive
} })
}
where where
render :: (State i) -> H.ComponentHTML (Query i) render :: forall m. (State i) -> H.ComponentHTML (Action i) () m
render state = render state =
HH.div HH.div
[ HP.ref state.elRef ] [ HP.ref state.elRef ]
[] []
eval :: (Query i) ~> H.ComponentDSL (State i) (Query i) Output Aff handleAction :: (Action i) -> H.HalogenM (State i) (Action i) () o Aff Unit
eval = case _ of handleAction = case _ of
SetInnerHTML a -> do SetInnerHTML -> do
{ elRef } <- H.get { elRef } <- H.get
mel <- H.getHTMLElementRef elRef mel <- H.getHTMLElementRef elRef
for_ mel \el -> do for_ mel \el -> do
{ inputval } <- H.get { inputval } <- H.get
H.liftEffect (unsafeSetInnerHTML el (toRawHTML inputval)) H.liftEffect (unsafeSetInnerHTML el (toRawHTML inputval))
pure a pure unit
Receive inputval a -> do Receive inputval -> do
H.modify_ _ { inputval = inputval } H.modify_ _ { inputval = inputval }
eval $ SetInnerHTML a handleAction $ SetInnerHTML

2
static/js/app.min.js vendored
View file

File diff suppressed because one or more lines are too long

BIN
static/js/app.min.js.gz
View file

Binary file not shown.

2
static/js/app.min.map
View file

File diff suppressed because one or more lines are too long

BIN
static/js/app.min.map.gz
View file

Binary file not shown.