upgrade to halogen v5.0.0-rc.1
This commit is contained in:
parent
92e22e5be8
commit
a44cd8e2b3
70
espial.cabal
70
espial.cabal
|
@ -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
|
||||||
|
|
|
@ -1,10 +1,15 @@
|
||||||
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 = {=}
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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)
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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 =
|
||||||
|
H.mkComponent
|
||||||
{ initialState: \inputval -> { elRef: H.RefLabel "inputval", inputval }
|
{ initialState: \inputval -> { elRef: H.RefLabel "inputval", inputval }
|
||||||
, render
|
, render
|
||||||
, eval
|
, eval: H.mkEval (H.defaultEval { handleAction = handleAction
|
||||||
, receiver: HE.input Receive
|
, initialize = Just SetInnerHTML
|
||||||
, initializer: Just $ H.action SetInnerHTML
|
, receive = Just <<< Receive
|
||||||
, finalizer: Nothing
|
})
|
||||||
}
|
}
|
||||||
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
2
static/js/app.min.js
vendored
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
Loading…
Reference in a new issue