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
--
-- hash: 7227333703029085a8041c55bcc653a2b000338e12bb43813bf9b349cfab6a11
-- hash: c9ea5f2d822708beca3dc6ea7fdfd09698f9f2df05afb37ac16e204d89a528c2
name: espial
version: 0.0.8
@ -95,6 +95,30 @@ flag library-only
default: False
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:
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
@ -160,34 +184,13 @@ library
cpp-options: -DDEVELOPMENT
else
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
executable espial
main-is: main.hs
other-modules:
DevelMain
Paths_espial
hs-source-dirs:
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
@ -252,13 +255,12 @@ executable espial
, yesod-static >=1.6 && <1.7
if flag(library-only)
buildable: False
other-modules:
DevelMain
Paths_espial
default-language: Haskell2010
executable migration
main-is: Main.hs
other-modules:
Paths_espial
hs-source-dirs:
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
@ -324,13 +326,16 @@ executable migration
, yesod-static >=1.6 && <1.7
if flag(library-only)
buildable: False
other-modules:
Paths_espial
default-language: Haskell2010
test-suite test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Handler.CommonSpec
Handler.HomeSpec
TestImport
Paths_espial
hs-source-dirs:
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
@ -395,9 +400,4 @@ test-suite test
, yesod-form >=1.6 && <1.7
, yesod-static >=1.6 && <1.7
, yesod-test
other-modules:
Handler.CommonSpec
Handler.HomeSpec
TestImport
Paths_espial
default-language: Haskell2010

13
purs/packages.dhall
View file

@ -1,11 +1,16 @@
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 =
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 = {=}
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.Elements (label)
import Halogen.HTML.Events (onChecked)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (InputType(..), checked, for, id_, name, type_)
import Model (AccountSettings)
import Util (class_)
@ -24,9 +23,9 @@ type UState =
_us :: Lens' UState AccountSettings
_us = lens _.us (_ { us = _ })
data UQuery a
= UEditField EditField a
| USubmit Event a
data UAction
= UEditField EditField
| USubmit Event
data EditField
= EarchiveDefault Boolean
@ -35,13 +34,12 @@ data EditField
-- | 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' =
H.component
H.mkComponent
{ initialState: const (mkState u')
, render
, eval
, receiver: const Nothing
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
}
where
app = app' unit
@ -50,7 +48,7 @@ usetting u' =
{ us: u
}
render :: UState -> H.ComponentHTML UQuery
render :: forall m. UState -> H.ComponentHTML UAction () m
render { us } =
div [ class_ "settings-form" ]
[ div [ class_ "fw7 mb2"] [ text "Account Settings" ]
@ -74,18 +72,16 @@ usetting u' =
]
]
where
editField :: forall a. (a -> EditField) -> a -> Maybe (UQuery Unit)
editField f = HE.input UEditField <<< f
editField :: forall a. (a -> EditField) -> a -> Maybe UAction
editField f = Just <<< UEditField <<< f
eval :: UQuery ~> H.ComponentDSL UState UQuery Unit Aff
eval (UEditField f next) = do
handleAction :: UAction -> H.HalogenM UState UAction () o Aff Unit
handleAction (UEditField f) = do
_us %= case f of
EarchiveDefault e -> _ { archiveDefault = e }
EprivateDefault e -> _ { privateDefault = e }
EprivacyLock e -> _ { privacyLock = e }
pure next
eval (USubmit e next) = do
handleAction (USubmit e) = do
us <- use _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.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 as HE
import Halogen.HTML.Properties (autofocus, ButtonType(..), InputType(..), autocomplete, checked, for, id_, name, required, rows, title, type_, value)
import Model (Bookmark)
import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_)
@ -25,11 +24,11 @@ import Web.Event.Event (Event, preventDefault)
import Web.HTML (window)
import Web.HTML.Location (setHref)
data BQuery a
= BEditField EditField a
| BEditSubmit Event a
| BDeleteAsk Boolean a
| BDestroy a
data BAction
= BEditField EditField
| BEditSubmit Event
| BDeleteAsk Boolean
| BDestroy
data EditField
= Eurl String
@ -52,13 +51,12 @@ _bm = lens _.bm (_ { bm = _ })
_edit_bm :: Lens' BState Bookmark
_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' =
H.component
H.mkComponent
{ initialState: const (mkState b')
, render
, eval
, receiver: const Nothing
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
}
where
app = app' unit
@ -70,12 +68,12 @@ addbmark b' =
, destroyed: false
}
render :: BState -> H.ComponentHTML BQuery
render :: forall m. BState -> H.ComponentHTML BAction () m
render s@{ bm, edit_bm } =
div_ [ if not s.destroyed then display_edit else display_destroyed ]
where
display_edit =
form [ onSubmit (HE.input BEditSubmit) ]
form [ onSubmit (Just <<< BEditSubmit) ]
[ table [ class_ "w-100" ]
[ tbody_
[ tr_
@ -128,10 +126,10 @@ addbmark b' =
[ text (maybe " " fst mmoment) ]
, div [ class_ "edit_links dib ml1" ]
[ 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" ])
[ button [ type_ ButtonButton, onClick (HE.input_ (BDeleteAsk false))] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick (HE.input_ BDestroy), class_ "red" ] [ text "destroy" ]
[ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk false)] [ text "cancel / " ]
, 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"]
editField :: forall a. (a -> EditField) -> a -> Maybe (BQuery Unit)
editField f = HE.input BEditField <<< f
editField :: forall a. (a -> EditField) -> a -> Maybe BAction
editField f = Just <<< BEditField <<< f
mmoment = mmoment8601 bm.time
toTextarea =
drop 1
<<< foldMap (\x -> [br_, text x])
<<< S.split (Pattern "\n")
eval :: BQuery ~> H.ComponentDSL BState BQuery Unit Aff
eval (BDeleteAsk e next) = do
handleAction :: BAction -> H.HalogenM BState BAction () o Aff Unit
handleAction (BDeleteAsk e) = do
H.modify_ (_ { deleteAsk = e })
pure next
eval (BDestroy next) = do
handleAction (BDestroy) = do
bid <- H.gets _.bm.bid
void $ H.liftAff (destroy bid)
H.modify_ (_ { destroyed = true })
pure next
eval (BEditField f next) = do
handleAction (BEditField f) = do
_edit_bm %= case f of
Eurl e -> _ { url = e }
Etitle e -> _ { title = e }
@ -164,8 +160,7 @@ addbmark b' =
Etags e -> _ { tags = e }
Eprivate e -> _ { private = e }
Etoread e -> _ { toread = e }
pure next
eval (BEditSubmit e next) = do
handleAction (BEditSubmit e) = do
H.liftEffect (preventDefault e)
edit_bm <- use _edit_bm
void $ H.liftAff (editBookmark edit_bm)
@ -176,4 +171,3 @@ addbmark b' =
case _lookupQueryStringValue qs "next" of
Just n -> liftEffect (setHref n loc)
_ -> liftEffect (closeWindow win)
pure next

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

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

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

@ -16,21 +16,21 @@ import Globals (app', mmoment8601)
import Halogen as H
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 as HE
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, checked, for, href, id_, name, required, rows, target, title, type_, value)
import Model (Bookmark)
import Util (class_, attr, fromNullableStr)
import Web.Event.Event (Event, preventDefault)
import Data.Const (Const)
-- | UI Events
data BQuery a
= BStar Boolean a
| BDeleteAsk Boolean a
| BDestroy a
| BEdit Boolean a
| BEditField EditField a
| BEditSubmit Event a
| BMarkRead a
data BAction
= BStar Boolean
| BDeleteAsk Boolean
| BDestroy
| BEdit Boolean
| BEditField EditField
| BEditSubmit Event
| BMarkRead
-- | FormField Edits
data EditField
@ -45,6 +45,8 @@ data EditField
data BMessage
= BNotifyRemove
type BSlot = H.Slot (Const Void) BMessage
type BState =
{ bm :: Bookmark
, edit_bm :: Bookmark
@ -61,13 +63,12 @@ _edit_bm = lens _.edit_bm (_ { edit_bm = _ })
_edit :: Lens' BState Boolean
_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' =
H.component
H.mkComponent
{ initialState: const (mkState b')
, render
, eval
, receiver: const Nothing
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
}
where
app = app' unit
@ -79,7 +80,7 @@ bmark b' =
, edit: false
}
render :: BState -> H.ComponentHTML BQuery
render :: forall m. BState -> H.ComponentHTML BAction () m
render s@{ bm, edit_bm } =
div [ id_ (show bm.bid) , class_ ("bookmark w-100 mw7 pa1 mb3" <> guard bm.private " private")] $
star <>
@ -91,7 +92,7 @@ bmark b' =
star =
guard app.dat.isowner
[ 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 =
@ -121,7 +122,7 @@ bmark b' =
display_edit =
[ div [ class_ "edit_bookmark_form pa2 pt0 bg-white" ] $
[ form [ onSubmit (HE.input BEditSubmit) ]
[ form [ onSubmit (Just <<< BEditSubmit) ]
[ div_ [ text "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) ]
@ -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" ]
, text " "
, 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 =
guard app.dat.isowner
[ 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" ]
[ 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") ] )
[ button [ type_ ButtonButton, onClick (HE.input_ (BDeleteAsk false))] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick (HE.input_ BDestroy), class_ "red" ] [ text "destroy" ]
[ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk false)] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick \_ -> Just BDestroy, class_ "red" ] [ text "destroy" ]
]
]
]
, div [ class_ "read di" ] $
guard bm.toread
[ 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 f = HE.input BEditField <<< f
editField :: forall a. (a -> EditField) -> a -> Maybe BAction
editField f = Just <<< BEditField <<< f
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
mmoment = mmoment8601 bm.time
@ -190,44 +191,39 @@ bmark b' =
# foldMap (\x -> [br_, text x])
# drop 1
eval :: BQuery ~> H.ComponentDSL BState BQuery BMessage Aff
handleAction :: BAction -> H.HalogenM BState BAction () BMessage Aff Unit
-- | Star
eval (BStar e next) = do
handleAction (BStar e) = do
bm <- use _bm
H.liftAff (toggleStar bm.bid (if e then Star else UnStar))
_bm %= _ { selected = e }
_edit_bm %= _ { selected = e }
pure next
-- | Delete
eval (BDeleteAsk e next) = do
handleAction (BDeleteAsk e) = do
H.modify_ (_ { deleteAsk = e })
pure next
-- | Destroy
eval (BDestroy next) = do
handleAction (BDestroy) = do
bm <- use _bm
void $ H.liftAff (destroy bm.bid)
H.raise BNotifyRemove
pure next
-- | Mark Read
eval (BMarkRead next) = do
handleAction (BMarkRead) = do
bm <- use _bm
void (H.liftAff (markRead bm.bid))
_bm %= _ { toread = false }
pure next
-- | Start/Stop Editing
eval (BEdit e next) = do
handleAction (BEdit e) = do
bm <- use _bm
_edit_bm .= bm
_edit .= e
pure next
-- | Update Form Field
eval (BEditField f next) = do
handleAction (BEditField f) = do
_edit_bm %= case f of
Eurl e -> _ { url = e }
Etitle e -> _ { title = e }
@ -235,13 +231,11 @@ bmark b' =
Etags e -> _ { tags = e }
Eprivate e -> _ { private = e }
Etoread e -> _ { toread = e }
pure next
-- | Submit
eval (BEditSubmit e next) = do
handleAction (BEditSubmit e) = do
H.liftEffect (preventDefault e)
edit_bm <- use _edit_bm
void $ H.liftAff (editBookmark edit_bm)
_bm .= edit_bm
_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 (Query(Receive)) as RHExt
import Effect.Aff (Aff)
import Foreign.Marked (marked)
import Halogen as H
import Halogen.HTML as HH
type MInput = String
type MQuery = RH.Query String
type MOutput = RH.Output
component :: H.Component HH.HTML MQuery MInput MOutput Aff
component :: forall q o. H.Component HH.HTML q String o Aff
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 Util (class_, fromNullableStr)
data NLQuery a
= NLNop a
type NLSlot = NoteSlug
data NLAction
= NLNop
type NLState =
{ notes :: Array Note
, cur :: Maybe NLSlot
, cur :: Maybe NoteSlug
, deleteAsk:: 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' =
H.component
H.mkComponent
{ initialState: const (mkState st')
, render
, eval
, receiver: const Nothing
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
}
where
app = app' unit
@ -47,11 +44,10 @@ nlist st' =
, edit: false
}
render :: NLState -> H.ComponentHTML NLQuery
render :: NLState -> H.ComponentHTML NLAction () Aff
render st@{ notes } =
HH.div_ (map renderNote notes)
where
renderNote :: Note -> H.ComponentHTML NLQuery
renderNote bm =
div [ id_ (show bm.id) , class_ ("note w-100 mw7 pa1 mb2")] $
[ div [ class_ "display" ] $
@ -71,5 +67,5 @@ nlist st' =
# foldMap (\x -> [br_, text x])
# drop 1
eval :: NLQuery ~> H.ComponentDSL NLState NLQuery Void Aff
eval (NLNop next) = pure next
handleAction :: NLAction -> H.HalogenM NLState NLAction () o Aff Unit
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 as HH
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 Model (Note)
import Util (_loc, class_, fromNullableStr)
import Web.Event.Event (Event, preventDefault)
import Web.HTML.Location (setHref)
import Data.Symbol (SProxy(..))
import Data.Const (Const)
data NQuery a
= NNop a
| NEditField EditField a
| NEditSubmit Event a
| NEdit Boolean a
| NDeleteAsk Boolean a
| NDestroy a
data NAction
= NNop
| NEditField EditField
| NEditSubmit Event
| NEdit Boolean
| NDeleteAsk Boolean
| NDestroy
type NState =
{ note :: Note
@ -57,15 +58,18 @@ data EditField
| Etext String
| 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' =
H.parentComponent
H.mkComponent
{ initialState: const (mkState st')
, render
, eval
, receiver: const Nothing
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
}
where
app = app' unit
@ -78,7 +82,7 @@ nnote st' =
, destroyed: false
}
render :: NState -> H.ParentHTML NQuery NChildQuery Unit Aff
render :: NState -> H.ComponentHTML NAction ChildSlots Aff
render st@{ note, edit_note } =
if st.destroyed
then display_destroyed
@ -95,7 +99,7 @@ nnote st' =
[ text $ if S.null note.title then "[no title]" else note.title ]
, br_
, 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)
, div [ class_ "link f7 dib gray w4", title (maybe note.created snd (mmoment note)) ]
[ text (maybe " " fst (mmoment note)) ]
@ -103,19 +107,19 @@ nnote st' =
]
<> -- | Render Action Links
[ 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" ]
[ 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") ] )
[ button [ type_ ButtonButton, onClick (HE.input_ (NDeleteAsk false))] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick (HE.input_ NDestroy), class_ "red" ] [ text "destroy" ]
[ button [ type_ ButtonButton, onClick \_ -> Just (NDeleteAsk false)] [ text "cancel / " ]
, button [ type_ ButtonButton, onClick \_ -> Just NDestroy, class_ "red" ] [ text "destroy" ]
]
]
]
]
renderNote_edit =
form [ onSubmit (HE.input NEditSubmit) ]
form [ onSubmit (Just <<< NEditSubmit) ]
[ p [ class_ "mt2 mb1"] [ text "title:" ]
, input [ type_ InputText , class_ "title w-100 mb1 pt1 f7 edit_form_input" , name "title"
, 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" ]
, text " "
, 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"]
mmoment n = mmoment8601 n.created
editField :: forall a. (a -> EditField) -> a -> Maybe (NQuery Unit)
editField f = HE.input NEditField <<< f
editField :: forall a. (a -> EditField) -> a -> Maybe NAction
editField f = Just <<< NEditField <<< f
toTextarea input =
S.split (Pattern "\n") input
# foldMap (\x -> [br_, text x])
# drop 1
eval :: NQuery ~> H.ParentDSL NState NQuery NChildQuery Unit Void Aff
eval (NNop next) = pure next
handleAction :: NAction -> H.HalogenM NState NAction ChildSlots o Aff Unit
handleAction (NNop) = pure unit
-- | EditField
eval (NEditField f next) = do
handleAction (NEditField f) = do
_edit_note %= case f of
Etitle e -> _ { title = e }
Etext e -> _ { text = e }
EisMarkdown e -> _ { isMarkdown = e }
pure next
-- | Delete
eval (NDeleteAsk e next) = do
handleAction (NDeleteAsk e) = do
H.modify_ (_ { deleteAsk = e })
pure next
-- | Destroy
eval (NDestroy next) = do
handleAction (NDestroy) = do
note <- use _note
void $ H.liftAff (destroyNote note.id)
H.modify_ (_ { destroyed = true })
pure next
-- | Start/Stop Editing
eval (NEdit e next) = do
handleAction (NEdit e) = do
note <- use _note
_edit_note .= note
_edit .= e
pure next
-- | Submit
eval (NEditSubmit e next) = do
handleAction (NEditSubmit e) = do
H.liftEffect (preventDefault e)
edit_note <- use _edit_note
res <- H.liftAff (editNote edit_note)
case res.body of
Left err -> pure next
Left err -> pure unit
Right r -> do
if (edit_note.id == 0)
then do
@ -194,4 +194,3 @@ nnote st' =
else do
_note .= edit_note
_edit .= false
pure next

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

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