<commit_before>{-
Created       : by threepenny-gui/samples/CRUD
Last Modified : 2014 Aug 03 (Sun) 15:10:20 by <NAME>.
-}

{-# LANGUAGE RecursiveDo #-}

module CRUD2 where

import           Control.Monad               (void)
import           Data.List                   (isPrefixOf)
import qualified Data.Map                    as Map
import           Data.Maybe
import           Prelude                     hiding (lookup)

import qualified Graphics.UI.Threepenny      as UI
import           Graphics.UI.Threepenny.Core hiding (delete)

------------------------------------------------------------------------------

main :: IO ()
main = startGUI defaultConfig setup

setup :: Window -> UI ()
setup window = void $ mdo
    getBody window #+ [ mkSPVPanel "?subject" ]
    return window # set title "RDF Triple Browser"

mkSPVPanel :: String -> UI Element
mkSPVPanel name = mdo
    -- GUI elements
    createBtn   <- UI.button #+ [string "Create"]
    deleteBtn   <- UI.button #+ [string "Delete"]
    listBox     <- UI.listBox  bListBoxItems bSelection bDisplayDataItem
    (firstname, tDataItem)
                <- dataItem    bSelectionDataItem
    let uiDataItem = grid [[string name, element firstname]]
    element listBox # set (attr "size") "10" # set style [("width","200px")]

    -- events and behaviors
    let eSelection  = rumors $ UI.userSelection listBox
        eDataItemIn = rumors $ tDataItem
        eCreate     = UI.click createBtn
        eDelete     = UI.click deleteBtn

    -- database
    -- bDatabase :: Behavior (Database DataItem)
    let update' mkey x = flip update x <$> mkey
    bDatabase <- accumB emptydb $ concatenate <$> unions
        [ hcCreate' <$ eCreate
        , filterJust $ update' <$> bSelection <@> eDataItemIn
        , delete <$> filterJust (bSelection <@ eDelete)
        ]

    -- selection
    -- bSelection :: Behavior (Maybe DatabaseKey)
    bSelection <- stepper Nothing $ head <$> unions
        [ eSelection
        , Nothing <$ eDelete
        , Just . nextKey <$> bDatabase <@ eCreate
        ]

    let bLookup :: Behavior (DatabaseKey -> Maybe DataItem)
        bLookup = flip lookup <$> bDatabase

        bShowDataItem :: Behavior (DatabaseKey -> String)
        bShowDataItem = (maybe "" showDataItem .) <$> bLookup

        bDisplayDataItem = (UI.string .) <$> bShowDataItem

        bListBoxItems :: Behavior [DatabaseKey]
        bListBoxItems = (\show0 -> filter ((const True) . show0) . keys)
                    <$> bShowDataItem <*> bDatabase

        bSelectionDataItem :: Behavior (Maybe DataItem)
        bSelectionDataItem = (=<<) <$> bLookup <*> bSelection

    -- automatically enable / disable editing
    let
        bDisplayItem :: Behavior Bool
        bDisplayItem = maybe False (const True) <$> bSelection

    element deleteBtn # sink UI.enabled bDisplayItem
    element firstname # sink UI.enabled bDisplayItem

    -- GUI layout
    grid [
           [ uiDataItem ]
         , [ element listBox ]
         , [ row [element createBtn, element deleteBtn] ]
         ]

------------------------------------------------------------------------------
-- Database Model

type DatabaseKey = Int
data Database a  = Database { nextKey :: !Int, db :: Map.Map DatabaseKey a }

emptydb :: Database a
emptydb = Database 0 Map.empty

keys :: Database a -> [DatabaseKey]
keys    = Map.keys . db

hcCreate :: Database String -> Database String
hcCreate                      db0 = create "ONE" (create "TWO" (create "THREE" db0))

hcCreate' :: Database String -> Database String
hcCreate'    (Database newkey db0) = create "FOO" $ Database newkey     $ Map.map (++ "xx") db0

create :: a -> Database a -> Database a
create x     (Database newkey db0) = Database (newkey+1) $ Map.insert newkey x db0

update :: DatabaseKey -> a -> Database a -> Database a
update key x (Database newkey db0) = Database newkey     $ Map.insert key    x db0

delete :: DatabaseKey -> Database a -> Database a
delete key   (Database newkey db0) = Database newkey     $ Map.delete key      db0<commit_msg>More paring down.<commit_after>{-
Created       : by threepenny-gui/samples/CRUD
Last Modified : 2014 Aug 03 (Sun) 15:25:32 by <NAME>.
-}

{-# LANGUAGE RecursiveDo #-}

module CRUD2 where

import           Control.Monad               (void)
import qualified Data.Map                    as Map
import           Data.Maybe
import qualified Graphics.UI.Threepenny      as UI
import           Graphics.UI.Threepenny.Core hiding (delete)
import           Prelude                     hiding (lookup)

------------------------------------------------------------------------------

main :: IO ()
main = startGUI defaultConfig setup

setup :: Window -> UI ()
setup window = void $ mdo
    getBody window #+ [ mkSPVPanel "?subject" ]
    return window # set title "RDF Triple Browser"

mkSPVPanel :: String -> UI Element
mkSPVPanel spvType = mdo
    -- GUI elements
    submitBtn   <- UI.button #+ [string "Submit"]
    listBox     <- UI.listBox  bListBoxItems bSelection bDisplayDataItem
    (spvSelection, _)
                <- dataItem    bSelectionDataItem
    let uiDataItem = grid [[string spvType, element spvSelection]]
    element listBox # set (attr "size") "10" # set style [("width","200px")]

    -- events and behaviors
    let eSelection  = rumors $ UI.userSelection listBox
        eSubmit     = UI.click submitBtn

    -- database
    -- bDatabase :: Behavior (Database DataItem)
    bDatabase <- accumB emptydb $ concatenate <$> unions
        [ hcSubmit' <$ eSubmit
        ]

    -- selection
    -- bSelection :: Behavior (Maybe DatabaseKey)
    bSelection <- stepper Nothing $ head <$> unions
        [ eSelection
        , Just . nextKey <$> bDatabase <@ eSubmit
        ]

    let bLookup :: Behavior (DatabaseKey -> Maybe DataItem)
        bLookup = flip lookup <$> bDatabase

        bShowDataItem :: Behavior (DatabaseKey -> String)
        bShowDataItem = (maybe "" showDataItem .) <$> bLookup

        bDisplayDataItem = (UI.string .) <$> bShowDataItem

        bListBoxItems :: Behavior [DatabaseKey]
        bListBoxItems = (\show0 -> filter ((const True) . show0) . keys)
                    <$> bShowDataItem <*> bDatabase

        bSelectionDataItem :: Behavior (Maybe DataItem)
        bSelectionDataItem = (=<<) <$> bLookup <*> bSelection

    -- automatically enable / disable editing
    let
        bDisplayItem :: Behavior Bool
        bDisplayItem = maybe False (const True) <$> bSelection

    element spvSelection # sink UI.enabled bDisplayItem

    -- GUI layout
    grid [
           [ uiDataItem ]
         , [ element listBox ]
         , [ row [element submitBtn] ]
         ]

------------------------------------------------------------------------------
-- Database Model

type DatabaseKey = Int
data Database a  = Database { nextKey :: !Int, db :: Map.Map DatabaseKey a }

emptydb :: Database a
emptydb = Database 0 Map.empty

keys :: Database a -> [DatabaseKey]
keys    = Map.keys . db

hcSubmit :: Database String -> Database String
hcSubmit                      db0 = create "ONE" (create "TWO" (create "THREE" db0))

hcSubmit' :: Database String -> Database String
hcSubmit'    (Database newkey db0) = create "FOO" $ Database newkey     $ Map.map (++ "xx") db0

create :: a -> Database a -> Database a
create x     (Database newkey db0) = Database (newkey+1) $ Map.insert newkey x db0

delete :: DatabaseKey -> Database a -> Database a
delete key   (Database newkey db0) = Database newkey     $ Map.delete key      db0
{'fraction_non_alphanumeric': 0.14023416711016498, 'fraction_numerical': 0.008249068653539117, 'mean_word_length': 2.0507305194805197, 'pattern_counts': {'":': 0, '<': 52, '<?xml version=': 0, '>': 58, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1263899', 'n_tokens_mistral': 2164, 'n_tokens_neox': 2046, 'n_words': 659}