Safer names

Safer names

Original commit db9aa220d80da0134875386f9aff52e8c3610b5e

module TypeScript
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Char.Unicode (GeneralCategory(..), generalCategory, isLetter)
import Data.Foldable (for_, intercalate, maximum)

import Data.List as L

import Data.Map as M
import Data.Maybe (Maybe(Nothing, Just), maybe)
import Data.Set (Set)
import Data.Set as S

import Data.String as Str
import Data.String.Util as Str

import Data.String.Regex as Rx
import Data.String.Regex.Flags as RxFlags
import Data.String.Util (camelCase, capitalize)

import Data.Tuple (Tuple(..), fst)
import Partial.Unsafe (unsafePartial)
import Utils (mapM)
import Data.Either as Either

renderer :: Renderer
renderer =
    { name: "TypeScript"
    , aceMode: "typescript"
    , extension: "ts"
    , doc: typeScriptDoc
    , transforms:
        { nameForClass
        , unionName: Nothing
        , unionPredicate: Just unionPredicate
        , nextName: \s -> "other_" <> s
        , forbiddenNames: []
        , topLevelNameFromGiven: id
        , forbiddenFromTopLevelNameGiven: const []
        }
    }

unionPredicate :: IRType -> Maybe (Set IRType)
unionPredicate = case _ of
    IRUnion ur ->
        let s = unionToSet ur
        in case nullableFromSet s of
            Nothing -> Just s
            _ -> Nothing
    _ -> Nothing

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = interfaceNamify $ combineNames names

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || (generalCategory c == Just LetterNumber)

isStartCharacter :: Char -> Boolean
isStartCharacter c =
    isLetterCharacter c || c == '_'

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    case generalCategory c of
    Nothing -> false
    Just DecimalNumber -> true
    Just ConnectorPunctuation -> true
    Just NonSpacingMark -> true
    Just SpacingCombiningMark -> true
    Just Format -> true
    _ -> isLetterCharacter c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

renderUnion :: Set IRType -> Doc String
renderUnion s =
    case nullableFromSet s of
    Just x -> do
        rendered <- renderType x
        pure if isValueType x then rendered <> "?" else rendered
    Nothing -> do
        types <- mapM renderType $ L.fromFoldable s
        pure $ intercalate " | " types

renderType :: IRType -> Doc String
renderType = case _ of
    IRNothing -> pure "any" -- we can have arrays of nothing
    IRNull -> pure "any"
    IRInteger -> pure "number"
    IRDouble -> pure "number"
    IRBool -> pure "boolean"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderType a
        pure $ rendered <> "[]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderType t
        pure $ "Map<string, " <> rendered <> ">"
    IRUnion types -> renderUnion $ unionToSet types

interfaceNamify :: String -> String
interfaceNamify = Str.camelCase >>> Str.capitalize >>> legalizeIdentifier

propertyNamify :: String -> String
propertyNamify s
    | Rx.test needsQuotes s = "\"" <> s <> "\""
    | otherwise = s

needsQuotes :: Rx.Regex
needsQuotes = unsafePartial $ Either.fromRight $ Rx.regex "[-_. ]" RxFlags.noFlags

typeScriptDoc :: Doc Unit
typeScriptDoc = do
    top <- getTopLevel >>= renderType
    line $ """// To parse this JSON data:
//
//     let result: """ <> top <> """ = JSON.parse(json);
//
"""
    classes <- getClasses
    for_ classes \(Tuple i cd) -> do
        interface <- lookupClassName i
        renderInterface cd interface
        blank

renderInterface :: IRClassData -> String -> Doc Unit
renderInterface (IRClassData { names, properties }) className = do
    let propertyNames = transformNames propertyNamify ("other " <> _) (S.singleton className) $ map (\n -> Tuple n n) $ M.keys properties
    line $ "interface " <> className <> " {"
    indent do
        let props = M.toUnfoldable properties :: Array _
        let resolved = props <#> \(Tuple a b) -> Tuple (lookupName a propertyNames) b
        let maxWidth = resolved <#> fst <#> Str.length # maximum
        for_ resolved \(Tuple pname ptype) -> do
            let indent = maybe 1 (\w -> w - Str.length pname + 1) maxWidth
            rendered <- renderType ptype
            line $ pname <> ":" <> Str.times " " indent <> rendered <> ";"
    line "}"

module TypeScript
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Char.Unicode (GeneralCategory(..), generalCategory, isLetter)
import Data.Foldable (for_, intercalate, maximum, maximumBy)
import Data.Function (on)
import Data.List (fromFoldable)
import Data.List as L
import Data.Map (keys)
import Data.Map as M
import Data.Maybe (Maybe(Nothing, Just), fromMaybe, maybe)
import Data.Set (Set)
import Data.Set as S
import Data.String (Pattern(..), contains, length)
import Data.String as Str
import Data.String.Util as Str
import Data.Tuple (Tuple(..), fst)
import Utils (mapM)

renderer :: Renderer
renderer =
    { name: "TypeScript"
    , aceMode: "typescript"
    , extension: "ts"
    , doc: typeScriptDoc
    , transforms:
        { nameForClass
        , unionName: Nothing
        , unionPredicate: Just unionPredicate
        , nextName: \s -> "other_" <> s
        , forbiddenNames: []
        , topLevelNameFromGiven: id
        , forbiddenFromTopLevelNameGiven: const []
        }
    }

unionPredicate :: IRType -> Maybe (Set IRType)
unionPredicate = case _ of
    IRUnion ur ->
        let s = unionToSet ur
        in case nullableFromSet s of
            Nothing -> Just s
            _ -> Nothing
    _ -> Nothing

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = interfaceNamify $ combineNames names

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || (generalCategory c == Just LetterNumber)

isStartCharacter :: Char -> Boolean
isStartCharacter c =
    isLetterCharacter c || c == '_'

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    case generalCategory c of
    Nothing -> false
    Just DecimalNumber -> true
    Just ConnectorPunctuation -> true
    Just NonSpacingMark -> true
    Just SpacingCombiningMark -> true
    Just Format -> true
    _ -> isLetterCharacter c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

renderUnion :: Set IRType -> Doc String
renderUnion s =
    case nullableFromSet s of
    Just x -> do
        rendered <- renderType x
        pure if isValueType x then rendered <> "?" else rendered
    Nothing -> do
        types <- mapM renderType $ L.fromFoldable s
        pure $ intercalate " | " types

renderType :: IRType -> Doc String
renderType = case _ of
    IRNothing -> pure "object" -- we can have arrays of nothing
    IRNull -> pure "object"
    IRInteger -> pure "long"
    IRDouble -> pure "double"
    IRBool -> pure "bool"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderType a
        pure $ rendered <> "[]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderType t
        pure $ "Map<string, " <> rendered <> ">"
    IRUnion types -> renderUnion $ unionToSet types

interfaceNamify :: String -> String
interfaceNamify = Str.camelCase >>> Str.capitalize >>> legalizeIdentifier

propertyNamify :: String -> String
propertyNamify s
    | Str.contains (Str.Pattern " ") s = "\"" <> s <> "\""
    | otherwise = s

typeScriptDoc :: Doc Unit
typeScriptDoc = do
    top <- getTopLevel >>= renderType
    line $ """// To parse this JSON data:
//
//     let result: """ <> top <> """ = JSON.parse(json);
//
"""
    classes <- getClasses
    for_ classes \(Tuple i cd) -> do
        interface <- lookupClassName i
        renderInterface cd interface
        blank

renderInterface :: IRClassData -> String -> Doc Unit
renderInterface (IRClassData { names, properties }) className = do
    let propertyNames = transformNames propertyNamify ("other " <> _) (S.singleton className) $ map (\n -> Tuple n n) $ M.keys properties
    line $ "interface " <> className <> " {"
    indent do
        let props = M.toUnfoldable properties :: Array _
        let resolved = props <#> \(Tuple a b) -> Tuple (lookupName a propertyNames) b
        let maxWidth = props <#> fst <#> Str.length # maximum
        for_ props \(Tuple pname ptype) -> do
            let indent = maybe 1 (\w -> w - Str.length pname + 1) maxWidth
            rendered <- renderType ptype
            line $ pname <> ":" <> Str.times " " indent <> rendered <> ";"
    line "}"


Fix notification action display (#1452)

Fix notification action display (#1452)

* Fix notification action display

* Fix order of details

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Notification.Component
  ( State
  , Query(..)
  , NotificationItem
  , RenderMode(..)
  , Expanded
  , DetailsPresented
  , Message(..)
  , component
  , initialState
  , renderModeFromAccessType
  , module N
  ) where

import SlamData.Prelude

import Control.Monad.Aff (later', forkAff)
import Control.Monad.Aff.AVar (AVar, makeVar, takeVar, putVar)

import Data.Array as Array
import Data.HeytingAlgebra (tt, ff, implies)
import Data.Int as Int
import Data.Time.Duration (Milliseconds(..))

import Halogen as H
import Halogen.Component.Utils (busEventSource)
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP

import SlamData.Monad (Slam)
import SlamData.Notification as N
import SlamData.Wiring as Wiring
import SlamData.Workspace.AccessType (AccessType(Editable, ReadOnly))

import Utils (lowercaseFirstChar, removeLastCharIfPeriod, parenthesize)

data Expanded = Expanded | Shrunk

data DetailsPresented = DetailsPresented | DetailsHidden

detailsPresentedToBoolean ∷ DetailsPresented → Boolean
detailsPresentedToBoolean =
  case _ of
    DetailsPresented → true
    DetailsHidden → false

booleanToDetailsPresented ∷ Boolean → DetailsPresented
booleanToDetailsPresented =
  case _ of
    true → DetailsPresented
    false → DetailsHidden

instance heytingAlgebraDetailsPresented :: HeytingAlgebra DetailsPresented where
  ff =
    booleanToDetailsPresented ff
  tt =
    booleanToDetailsPresented tt
  implies a b =
    booleanToDetailsPresented
      $ (detailsPresentedToBoolean a) `implies` (detailsPresentedToBoolean b)
  conj a =
    booleanToDetailsPresented
      ∘ (conj $ detailsPresentedToBoolean a)
      ∘ detailsPresentedToBoolean
  disj a =
    booleanToDetailsPresented
      ∘ (disj $ detailsPresentedToBoolean a)
      ∘ detailsPresentedToBoolean
  not =
    booleanToDetailsPresented
      ∘ not
      ∘ detailsPresentedToBoolean

data RenderMode = Notifications | ExpandableList Expanded

type State =
  { tick ∷ Int
  , queue ∷ Array NotificationItem
  , current ∷ Maybe NotificationItem
  , dismissed ∷ Maybe NotificationItem
  , renderMode ∷ RenderMode
  }

type NotificationItem =
  { id ∷ Int
  , dismiss ∷ AVar Unit
  , options ∷ N.NotificationOptions
  , detailsPresented ∷ DetailsPresented
  }

renderModeFromAccessType ∷ AccessType → RenderMode
renderModeFromAccessType =
  case _ of
    Editable → Notifications
    ReadOnly → ExpandableList Shrunk

initialState ∷ RenderMode → State
initialState renderMode =
  { tick: 0
  , queue: [ ]
  , current: Nothing
  , dismissed: Nothing
  , renderMode
  }

data Query a
  = Init a
  | Push N.NotificationOptions (H.SubscribeStatus -> a)
  | ToggleDetail a
  | Action N.Action a
  | Dismiss a
  | ExpandList a
  | UpdateRenderMode RenderMode a

data Status
  = Current
  | Dismissed

type Message = N.Action

type NotifyHTML = H.ComponentHTML Query

type NotifyDSL = H.ComponentDSL State Query Message Slam

component ∷ RenderMode → H.Component HH.HTML Query Unit Message Slam
component renderMode =
  H.lifecycleComponent
    { initialState: const (initialState renderMode)
    , render
    , eval
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    , receiver: const Nothing
    }

render ∷ State → NotifyHTML
render st =
  case st.renderMode of
    Notifications →
      HH.div
        [ HP.class_ (HH.ClassName "sd-notifications") ]
        [ renderNotification Dismissed st.dismissed
        , renderNotification Current st.current
        ]
    ExpandableList Shrunk →
      HH.div
        [ HP.class_ $ HH.ClassName "sd-notifications-list" ]
        if (Array.length all > 0)
          then
            [ HH.button
                [ HP.classes [ HH.ClassName "btn", HH.ClassName "btn-primary" ]
                , HP.type_ HP.ButtonButton
                , HE.onClick $ HE.input_ ExpandList
                ]
                [ HH.text "More details" ]
            ]
          else
            []
    ExpandableList Expanded →
      HH.div
        [ HP.class_ (HH.ClassName "sd-notifications-list") ]
        [ HH.ul_ $ renderListItem <$> all ]

  where
  all =
    maybe [] pure st.current <> st.queue

  renderNotification status = maybe (HH.text "") \n →
    HH.div
      [ HP.class_ (HH.ClassName "sd-notification-spacer") ]
      [ HH.div
          [ HP.classes (notificationClasses status n.options.notification) ]
          [ HH.div
              [ HP.class_ (HH.ClassName "sd-notification-text") ]
              ([ HH.text (notificationText n.options.notification) ]
              <> case n.options of
                   { detail: Just opts, actionOptions: Just aopts } → [ renderMessage aopts, renderDetail n opts ]
                   { detail: Just opts } → [ renderDetail n opts ]
                   { actionOptions: Just aopts } → [ renderMessage aopts, renderAction aopts ]
                   _ → [])
          , HH.div
              [ HP.class_ (HH.ClassName "sd-notification-buttons") ]
              [ HH.button
                  [ HP.class_ (HH.ClassName "sd-notification-dismiss")
                  , HP.type_ HP.ButtonButton
                  , HE.onClick (HE.input_ Dismiss)
                  ]
                  [ HH.text "×" ]
              ]
          ]
      ]

  renderListItem n =
    HH.li_
      [ HH.text
          $ removeLastCharIfPeriod (notificationText n.options.notification)
          <> maybe
               ""
               (\(N.Details s) →
                  " " <> (parenthesize $ lowercaseFirstChar $ removeLastCharIfPeriod $ s))
               n.options.detail
          <> "."
      ]

  renderDetail n (N.Details d) =
    HH.div
      [ HP.class_ (HH.ClassName "sd-notification-detail") ]
      [ HH.button
          [ HP.classes [ HH.ClassName "btn", HH.ClassName "btn-default", HH.ClassName "btn-sm" ]
          , HP.type_ HP.ButtonButton
          , HE.onClick (HE.input_ ToggleDetail)
          ]
          [ HH.text
              case n.detailsPresented of
                DetailsPresented → "Hide detail"
                DetailsHidden → "Show detail"
          ]
      , n.options.actionOptions
          # maybe (HH.text "") renderActionButton
      , case n.detailsPresented of
          DetailsPresented →
            HH.div
              [ HP.class_ (HH.ClassName "sd-notification-detail") ]
              [ HH.p_ [ HH.text d ] ]
          DetailsHidden → HH.text ""
      ]

  renderAction opts@(N.ActionOptions a) =
    HH.div
      [ HP.class_ (HH.ClassName "sd-notification-detail") ]
      [ renderActionButton opts ]

  renderActionButton (N.ActionOptions a) =
    HH.button
      [ HP.classes [ HH.ClassName "btn", HH.ClassName "btn-primary", HH.ClassName "btn-sm" ]
      , HP.type_ HP.ButtonButton
      , HE.onClick (HE.input_ $ Action a.action)
      ]
      [ HH.text a.actionMessage ]

  renderMessage (N.ActionOptions { message })
      | message ≡ "" = HH.text ""
      | otherwise =
          HH.div
            [ HP.class_ (HH.ClassName "sd-notification-detail") ]
            [ HH.p_ [ HH.text message ] ]

  notificationClasses status n =
    [ HH.ClassName "sd-notification"
    , HH.ClassName case n of
        N.Info _    → "info"
        N.Warning _ → "warning"
        N.Error _   → "error"
    , HH.ClassName case status of
        Current   → "current"
        Dismissed → "dismissed"
    ]

  notificationText = case _ of
    N.Info s → s
    N.Warning s → s
    N.Error s → s

eval ∷ Query ~> NotifyDSL
eval = case _ of
  Init next → do
    { bus } ← Wiring.expose
    H.subscribe $ busEventSource (H.request <<< Push) bus.notify
    pure next
  Push options reply → do
    st ← H.get
    dismiss ← H.liftAff makeVar
    when
      (not (options `optionsEqItem` st.current ∨ options `optionsEqItem` Array.last st.queue))
      do
        let item =
              { id: st.tick
              , dismiss
              , options
              , detailsPresented: DetailsHidden
              }
        H.modify _
          { tick = st.tick + 1
          , queue = Array.snoc st.queue item
          }
        when (isNothing st.current) drainQueue
    pure $ reply H.Listening
  Dismiss next → do
    dismissNotification
    pure next
  Action act next → do
    dismissNotification
    H.raise act
    pure next
  ToggleDetail next → do
    current ← H.gets _.current
    for_ current \curr →
      H.modify _ { current = Just curr { detailsPresented = not curr.detailsPresented } }
    pure next
  ExpandList next →
    H.modify _ { renderMode = ExpandableList Expanded } $> next
  UpdateRenderMode renderMode next →
    H.modify _ { renderMode = renderMode } $> next
  where
  optionsEqItem ∷ N.NotificationOptions → Maybe NotificationItem → Boolean
  optionsEqItem options =
    maybe false (N.optionsWithoutActionEq options) ∘ map _.options

dismissNotification ∷ NotifyDSL Unit
dismissNotification = do
  current ← H.gets _.current
  for_ current \{ dismiss } →
    H.liftAff $ putVar dismiss unit

drainQueue ∷ NotifyDSL Unit
drainQueue = do
  st ← H.get
  case Array.uncons st.queue of
    Nothing → do
      H.modify _
        { current = Nothing
        , dismissed = st.current
        }
    Just { head, tail } → do
      H.modify _
        { queue = tail
        , current = Just head
        , dismissed = st.current
        }

      -- TODO: Make notifications with timeouts not disapear in ExpandableList
      -- render mode
      for_ head.options.timeout \(Milliseconds ms) →
        H.liftAff $ forkAff $ later' (Int.floor ms) (putVar head.dismiss unit)

      H.liftAff $ takeVar head.dismiss
      drainQueue

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Notification.Component
  ( State
  , Query(..)
  , NotificationItem
  , RenderMode(..)
  , Expanded
  , DetailsPresented
  , Message(..)
  , component
  , initialState
  , renderModeFromAccessType
  , module N
  ) where

import SlamData.Prelude

import Control.Monad.Aff (later', forkAff)
import Control.Monad.Aff.AVar (AVar, makeVar, takeVar, putVar)

import Data.Array as Array
import Data.HeytingAlgebra (tt, ff, implies)
import Data.Int as Int
import Data.Time.Duration (Milliseconds(..))

import Halogen as H
import Halogen.Component.Utils (busEventSource)
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP

import SlamData.Monad (Slam)
import SlamData.Notification as N
import SlamData.Wiring as Wiring
import SlamData.Workspace.AccessType (AccessType(Editable, ReadOnly))

import Utils (lowercaseFirstChar, removeLastCharIfPeriod, parenthesize)

data Expanded = Expanded | Shrunk

data DetailsPresented = DetailsPresented | DetailsHidden

detailsPresentedToBoolean ∷ DetailsPresented → Boolean
detailsPresentedToBoolean =
  case _ of
    DetailsPresented → true
    DetailsHidden → false

booleanToDetailsPresented ∷ Boolean → DetailsPresented
booleanToDetailsPresented =
  case _ of
    true → DetailsPresented
    false → DetailsHidden

instance heytingAlgebraDetailsPresented :: HeytingAlgebra DetailsPresented where
  ff =
    booleanToDetailsPresented ff
  tt =
    booleanToDetailsPresented tt
  implies a b =
    booleanToDetailsPresented
      $ (detailsPresentedToBoolean a) `implies` (detailsPresentedToBoolean b)
  conj a =
    booleanToDetailsPresented
      ∘ (conj $ detailsPresentedToBoolean a)
      ∘ detailsPresentedToBoolean
  disj a =
    booleanToDetailsPresented
      ∘ (disj $ detailsPresentedToBoolean a)
      ∘ detailsPresentedToBoolean
  not =
    booleanToDetailsPresented
      ∘ not
      ∘ detailsPresentedToBoolean

data RenderMode = Notifications | ExpandableList Expanded

type State =
  { tick ∷ Int
  , queue ∷ Array NotificationItem
  , current ∷ Maybe NotificationItem
  , dismissed ∷ Maybe NotificationItem
  , renderMode ∷ RenderMode
  }

type NotificationItem =
  { id ∷ Int
  , dismiss ∷ AVar Unit
  , options ∷ N.NotificationOptions
  , detailsPresented ∷ DetailsPresented
  }

renderModeFromAccessType ∷ AccessType → RenderMode
renderModeFromAccessType =
  case _ of
    Editable → Notifications
    ReadOnly → ExpandableList Shrunk

initialState ∷ RenderMode → State
initialState renderMode =
  { tick: 0
  , queue: [ ]
  , current: Nothing
  , dismissed: Nothing
  , renderMode
  }

data Query a
  = Init a
  | Push N.NotificationOptions (H.SubscribeStatus -> a)
  | ToggleDetail a
  | Action N.Action a
  | Dismiss a
  | ExpandList a
  | UpdateRenderMode RenderMode a

data Status
  = Current
  | Dismissed

type Message = N.Action

type NotifyHTML = H.ComponentHTML Query

type NotifyDSL = H.ComponentDSL State Query Message Slam

component ∷ RenderMode → H.Component HH.HTML Query Unit Message Slam
component renderMode =
  H.lifecycleComponent
    { initialState: const (initialState renderMode)
    , render
    , eval
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    , receiver: const Nothing
    }

render ∷ State → NotifyHTML
render st =
  case st.renderMode of
    Notifications →
      HH.div
        [ HP.class_ (HH.ClassName "sd-notifications") ]
        [ renderNotification Dismissed st.dismissed
        , renderNotification Current st.current
        ]
    ExpandableList Shrunk →
      HH.div
        [ HP.class_ $ HH.ClassName "sd-notifications-list" ]
        if (Array.length all > 0)
          then
            [ HH.button
                [ HP.classes [ HH.ClassName "btn", HH.ClassName "btn-primary" ]
                , HP.type_ HP.ButtonButton
                , HE.onClick $ HE.input_ ExpandList
                ]
                [ HH.text "More details" ]
            ]
          else
            []
    ExpandableList Expanded →
      HH.div
        [ HP.class_ (HH.ClassName "sd-notifications-list") ]
        [ HH.ul_ $ renderListItem <$> all ]

  where
  all =
    maybe [] pure st.current <> st.queue

  renderNotification status = maybe (HH.text "") \n →
    HH.div
      [ HP.class_ (HH.ClassName "sd-notification-spacer") ]
      [ HH.div
          [ HP.classes (notificationClasses status n.options.notification) ]
          [ HH.div
              [ HP.class_ (HH.ClassName "sd-notification-text") ]
              [ HH.text (notificationText n.options.notification)
              , renderAction n
              , renderDetail n
              ]
          , HH.div
              [ HP.class_ (HH.ClassName "sd-notification-buttons") ]
              [ HH.button
                  [ HP.class_ (HH.ClassName "sd-notification-dismiss")
                  , HP.type_ HP.ButtonButton
                  , HE.onClick (HE.input_ Dismiss)
                  ]
                  [ HH.text "×" ]
              ]
          ]
      ]

  renderListItem n =
    HH.li_
      [ HH.text
          $ removeLastCharIfPeriod (notificationText n.options.notification)
          <> maybe
               ""
               (\(N.Details s) →
                  " " <> (parenthesize $ lowercaseFirstChar $ removeLastCharIfPeriod $ s))
               n.options.detail
          <> "."
      ]

  renderDetail n =
    n.options.detail
      # maybe
        (HH.text "")
        (\(N.Details d) → HH.div
          [ HP.class_ (HH.ClassName "sd-notification-detail") ]
          [ HH.button
              [ HP.classes [ HH.ClassName "btn", HH.ClassName "btn-default", HH.ClassName "btn-sm" ]
              , HP.type_ HP.ButtonButton
              , HE.onClick (HE.input_ ToggleDetail)
              ]
              [ HH.text
                  case n.detailsPresented of
                    DetailsPresented → "Hide detail"
                    DetailsHidden → "Show detail"
              ]
          , n.options.actionOptions
             # maybe
               (HH.text "")
               (\(N.ActionOptions a) →
                  HH.button
                    [ HP.classes [ HH.ClassName "btn", HH.ClassName "btn-primary", HH.ClassName "btn-sm" ]
                    , HP.type_ HP.ButtonButton
                    , HE.onClick (HE.input_ $ Action a.action)
                    ]
                    [ HH.text a.actionMessage ])
          , case n.detailsPresented of
              DetailsPresented →
                HH.div
                  [ HP.class_ (HH.ClassName "sd-notification-detail") ]
                  [ HH.p_ [ HH.text d ] ]
              DetailsHidden → HH.text ""
          ])

  renderAction n =
    n.options.actionOptions
      # maybe
        (HH.text "")
        (\(N.ActionOptions a) →
          HH.div
            [ HP.class_ (HH.ClassName "sd-notification-detail") ]
            [ HH.p_ [ HH.text a.message ] ])

  notificationClasses status n =
    [ HH.ClassName "sd-notification"
    , HH.ClassName case n of
        N.Info _    → "info"
        N.Warning _ → "warning"
        N.Error _   → "error"
    , HH.ClassName case status of
        Current   → "current"
        Dismissed → "dismissed"
    ]

  notificationText = case _ of
    N.Info s → s
    N.Warning s → s
    N.Error s → s

eval ∷ Query ~> NotifyDSL
eval = case _ of
  Init next → do
    { bus } ← Wiring.expose
    H.subscribe $ busEventSource (H.request <<< Push) bus.notify
    pure next
  Push options reply → do
    st ← H.get
    dismiss ← H.liftAff makeVar
    when
      (not (options `optionsEqItem` st.current ∨ options `optionsEqItem` Array.last st.queue))
      do
        let item =
              { id: st.tick
              , dismiss
              , options
              , detailsPresented: DetailsHidden
              }
        H.modify _
          { tick = st.tick + 1
          , queue = Array.snoc st.queue item
          }
        when (isNothing st.current) drainQueue
    pure $ reply H.Listening
  Dismiss next → do
    dismissNotification
    pure next
  Action act next → do
    dismissNotification
    H.raise act
    pure next
  ToggleDetail next → do
    current ← H.gets _.current
    for_ current \curr →
      H.modify _ { current = Just curr { detailsPresented = not curr.detailsPresented } }
    pure next
  ExpandList next →
    H.modify _ { renderMode = ExpandableList Expanded } $> next
  UpdateRenderMode renderMode next →
    H.modify _ { renderMode = renderMode } $> next
  where
  optionsEqItem ∷ N.NotificationOptions → Maybe NotificationItem → Boolean
  optionsEqItem options =
    maybe false (N.optionsWithoutActionEq options) ∘ map _.options

dismissNotification ∷ NotifyDSL Unit
dismissNotification = do
  current ← H.gets _.current
  for_ current \{ dismiss } →
    H.liftAff $ putVar dismiss unit

drainQueue ∷ NotifyDSL Unit
drainQueue = do
  st ← H.get
  case Array.uncons st.queue of
    Nothing → do
      H.modify _
        { current = Nothing
        , dismissed = st.current
        }
    Just { head, tail } → do
      H.modify _
        { queue = tail
        , current = Just head
        , dismissed = st.current
        }

      -- TODO: Make notifications with timeouts not disapear in ExpandableList
      -- render mode
      for_ head.options.timeout \(Milliseconds ms) →
        H.liftAff $ forkAff $ later' (Int.floor ms) (putVar head.dismiss unit)

      H.liftAff $ takeVar head.dismiss
      drainQueue


added purescript linear Search

added purescript linear Search

module LinearSearch where

-- Written and tested in in Purescript 0.12
import Prelude ((+), (==))
import Data.Array
import Data.Maybe (Maybe(..))

exampleSearch :: Maybe Int
exampleSearch = linear_Search [29,24,5,7,69,1,56] 5
--should answer Just 2

linear_Search :: Array Int -> Int -> Maybe Int
linear_Search arr value = search arr value 0

search :: Array Int -> Int -> Int -> Maybe Int
search arr value pos = case uncons arr of                -- uncons splits array into head and tail
        Just { head: x, tail: xs } ->
            if x == value then Just pos                  -- if found return the position
                          else search xs value (pos+1)   -- If its not found, recursively search
        Nothing -> Nothing

module LinearSearch where

-- Written in Purescript 0.12
import Prelude ((+), (==))
import Data.Array
import Data.Maybe (Maybe(..))

exampleSearch :: Maybe Int
exampleSearch = linear_Search [29,24,5,7,69,1,56] 5

linear_Search :: Array Int -> Int -> Maybe Int
linear_Search arr value = search arr value 0

search :: Array Int -> Int -> Int -> Maybe Int
search arr value pos = case uncons arr of 	 			 -- uncons splits array into head and tail
		Just { head: x, tail: xs } ->
			if x == value then Just pos 				 -- if found return the position
						  else search xs value (pos+1)   -- If its not found, recursively search
  		Nothing -> Nothing


JS classes

JS classes

module Language.PureScript.CodeGen.JS.AST where

import Prelude
import Data.Either
import Data.Maybe
import Data.Tuple
import Data.Generics

-- |
-- Built-in unary operators
--
data UnaryOperator
  -- |
  -- Numeric negation
  --
  = Negate
  -- |
  -- Boolean negation
  --
  | Not
  -- |
  -- Bitwise negation
  --
  | BitwiseNot
  -- |
  -- Numeric unary \'plus\'
  --
  | Positive

instance showUnaryOperator :: Show UnaryOperator where
  show = gshow

instance eqUnaryOperator :: Eq UnaryOperator where
  (==) = geq
  (/=) x y = not (geq x y)

instance genericUnaryOperator :: Generic UnaryOperator where
  typeOf _ = TyCon { tyCon: "Language.PureScript.CodeGen.JS.AST.UnaryOperator", args: [] }
  term Negate     = TmCon { con: "Language.PureScript.Names.Negate"     , values: [] }
  term Not        = TmCon { con: "Language.PureScript.Names.Not"        , values: [] }
  term BitwiseNot = TmCon { con: "Language.PureScript.Names.BitwiseNot" , values: [] }
  term Positive   = TmCon { con: "Language.PureScript.Names.Positive"   , values: [] }
  unTerm (TmCon { con = "Language.PureScript.Names.Negate"     }) = Just Negate
  unTerm (TmCon { con = "Language.PureScript.Names.Not"        }) = Just Not
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseNot" }) = Just BitwiseNot
  unTerm (TmCon { con = "Language.PureScript.Names.Positive"   }) = Just Positive
  unTerm _ = Nothing

-- |
-- Built-in binary operators
--
data BinaryOperator
  -- |
  -- Numeric addition
  --
  = Add
  -- |
  -- Numeric subtraction
  --
  | Subtract
  -- |
  -- Numeric multiplication
  --
  | Multiply
  -- |
  -- Numeric division
  --
  | Divide
  -- |
  -- Remainder
  --
  | Modulus
  -- |
  -- Generic equality test
  --
  | EqualTo
  -- |
  -- Generic inequality test
  --
  | NotEqualTo
  -- |
  -- Numeric less-than
  --
  | LessThan
  -- |
  -- Numeric less-than-or-equal
  --
  | LessThanOrEqualTo
  -- |
  -- Numeric greater-than
  --
  | GreaterThan
  -- |
  -- Numeric greater-than-or-equal
  --
  | GreaterThanOrEqualTo
  -- |
  -- Boolean and
  --
  | And
  -- |
  -- Boolean or
  --
  | Or
  -- |
  -- Bitwise and
  --
  | BitwiseAnd
  -- |
  -- Bitwise or
  --
  | BitwiseOr
  -- |
  -- Bitwise xor
  --
  | BitwiseXor
  -- |
  -- Bitwise left shift
  --
  | ShiftLeft
  -- |
  -- Bitwise right shift
  --
  | ShiftRight
  -- |
  -- Bitwise right shift with zero-fill
  --
  | ZeroFillShiftRight

instance showBinaryOperator :: Show BinaryOperator where
  show = gshow

instance eqBinaryOperator :: Eq BinaryOperator where
  (==) = geq
  (/=) x y = not (geq x y)

instance genericBinaryOperator :: Generic BinaryOperator where
  typeOf _ = TyCon { tyCon: "Language.PureScript.CodeGen.JS.AST.BinaryOperator", args: [] }
  term Add                  = TmCon { con: "Language.PureScript.Names.Add"                  , values: [] }
  term Subtract             = TmCon { con: "Language.PureScript.Names.Subtract"             , values: [] }
  term Multiply             = TmCon { con: "Language.PureScript.Names.Multiply"             , values: [] }
  term Divide               = TmCon { con: "Language.PureScript.Names.Divide"               , values: [] }
  term Modulus              = TmCon { con: "Language.PureScript.Names.Modulus"              , values: [] }
  term EqualTo              = TmCon { con: "Language.PureScript.Names.EqualTo"              , values: [] }
  term NotEqualTo           = TmCon { con: "Language.PureScript.Names.NotEqualTo"           , values: [] }
  term LessThan             = TmCon { con: "Language.PureScript.Names.LessThan"             , values: [] }
  term LessThanOrEqualTo    = TmCon { con: "Language.PureScript.Names.LessThanOrEqualTo"    , values: [] }
  term GreaterThan          = TmCon { con: "Language.PureScript.Names.GreaterThan"          , values: [] }
  term GreaterThanOrEqualTo = TmCon { con: "Language.PureScript.Names.GreaterThanOrEqualTo" , values: [] }
  term And                  = TmCon { con: "Language.PureScript.Names.And"                  , values: [] }
  term Or                   = TmCon { con: "Language.PureScript.Names.Or"                   , values: [] }
  term BitwiseAnd           = TmCon { con: "Language.PureScript.Names.BitwiseAnd"           , values: [] }
  term BitwiseOr            = TmCon { con: "Language.PureScript.Names.BitwiseOr"            , values: [] }
  term BitwiseXor           = TmCon { con: "Language.PureScript.Names.BitwiseXor"           , values: [] }
  term ShiftLeft            = TmCon { con: "Language.PureScript.Names.ShiftLeft"            , values: [] }
  term ShiftRight           = TmCon { con: "Language.PureScript.Names.ShiftRight"           , values: [] }
  term ZeroFillShiftRight   = TmCon { con: "Language.PureScript.Names.ZeroFillShiftRight"   , values: [] }
  unTerm (TmCon { con = "Language.PureScript.Names.Add"                  }) = Just Add
  unTerm (TmCon { con = "Language.PureScript.Names.Subtract"             }) = Just Subtract
  unTerm (TmCon { con = "Language.PureScript.Names.Multiply"             }) = Just Multiply
  unTerm (TmCon { con = "Language.PureScript.Names.Divide"               }) = Just Divide
  unTerm (TmCon { con = "Language.PureScript.Names.Modulus"              }) = Just Modulus
  unTerm (TmCon { con = "Language.PureScript.Names.EqualTo"              }) = Just EqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.NotEqualTo"           }) = Just NotEqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.LessThan"             }) = Just LessThan
  unTerm (TmCon { con = "Language.PureScript.Names.LessThanOrEqualTo"    }) = Just LessThanOrEqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.GreaterThan"          }) = Just GreaterThan
  unTerm (TmCon { con = "Language.PureScript.Names.GreaterThanOrEqualTo" }) = Just GreaterThanOrEqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.And"                  }) = Just And
  unTerm (TmCon { con = "Language.PureScript.Names.Or"                   }) = Just Or
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseAnd"           }) = Just BitwiseAnd
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseOr"            }) = Just BitwiseOr
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseXor"           }) = Just BitwiseXor
  unTerm (TmCon { con = "Language.PureScript.Names.ShiftLeft"            }) = Just ShiftLeft
  unTerm (TmCon { con = "Language.PureScript.Names.ShiftRight"           }) = Just ShiftRight
  unTerm (TmCon { con = "Language.PureScript.Names.ZeroFillShiftRight"   }) = Just ZeroFillShiftRight
  unTerm _ = Nothing

-- |
-- Data type for simplified Javascript expressions
--
data JS
  -- |
  -- A numeric literal
  --
  = JSNumericLiteral Number
  -- |
  -- A string literal
  --
  | JSStringLiteral String
  -- |
  -- A boolean literal
  --
  | JSBooleanLiteral Boolean
  -- |
  -- A unary operator application
  --
  | JSUnary UnaryOperator JS
  -- |
  -- A binary operator application
  --
  | JSBinary BinaryOperator JS JS
  -- |
  -- An array literal
  --
  | JSArrayLiteral [JS]
  -- |
  -- An array indexer expression
  --
  | JSIndexer JS JS
  -- |
  -- An object literal
  --
  | JSObjectLiteral [Tuple String JS]
  -- |
  -- An object property accessor expression
  --
  | JSAccessor String JS
  -- |
  -- A function introduction (optional name, arguments, body)
  --
  | JSFunction (Maybe String) [String] JS
  -- |
  -- Function application
  --
  | JSApp JS [JS]
  -- |
  -- Variable
  --
  | JSVar String
  -- |
  -- Conditional expression
  --
  | JSConditional JS JS JS
  -- |
  -- A block of expressions in braces
  --
  | JSBlock [JS]
  -- |
  -- A variable introduction and optional initialization
  --
  | JSVariableIntroduction String (Maybe JS)
  -- |
  -- A variable assignment
  --
  | JSAssignment JS JS
  -- |
  -- While loop
  --
  | JSWhile JS JS
  -- |
  -- For loop
  --
  | JSFor String JS JS JS
  -- |
  -- ForIn loop
  --
  | JSForIn String JS JS
  -- |
  -- If-then-else statement
  --
  | JSIfElse JS JS (Maybe JS)
  -- |
  -- Return statement
  --
  | JSReturn JS
  -- |
  -- Throw statement
  --
  | JSThrow JS
  -- |
  -- Type-Of operator
  --
  | JSTypeOf JS
  -- |
  -- Labelled statement
  --
  | JSLabel String JS
  -- |
  -- Break statement
  --
  | JSBreak String
  -- |
  -- Continue statement
  --
  | JSContinue String
  -- |
  -- Raw Javascript (for an inline foreign import declarations)
  --
  | JSRaw String

instance showJS :: Show JS where
  show = gshow

instance eqJS :: Eq JS where
  (==) = geq
  (/=) x y = not (geq x y)

instance genericJS :: Generic JS where
  typeOf _ = TyCon { tyCon: "Language.PureScript.CodeGen.JS.AST.BinaryOperator", args: [] }
  term (JSNumericLiteral n)              = TmCon { con: "Language.PureScript.Names.JSNumericLiteral"       , values: [term n] }
  term (JSStringLiteral s)               = TmCon { con: "Language.PureScript.Names.JSStringLiteral"        , values: [term s] }
  term (JSBooleanLiteral b)              = TmCon { con: "Language.PureScript.Names.JSBooleanLiteral"       , values: [term b] }
  term (JSUnary op x)                    = TmCon { con: "Language.PureScript.Names.JSUnary"                , values: [term op, term x] }
  term (JSBinary op x y)                 = TmCon { con: "Language.PureScript.Names.JSBinary"               , values: [term op, term x, term y] }
  term (JSArrayLiteral es)               = TmCon { con: "Language.PureScript.Names.JSArrayLiteral"         , values: [term es] }
  term (JSIndexer prop val)              = TmCon { con: "Language.PureScript.Names.JSIndexer"              , values: [term prop, term val] }
  term (JSObjectLiteral props)           = TmCon { con: "Language.PureScript.Names.JSObjectLiteral"        , values: [term props] }
  term (JSAccessor prop val)             = TmCon { con: "Language.PureScript.Names.JSAccessor"             , values: [term prop, term val] }
  term (JSFunction name args body)       = TmCon { con: "Language.PureScript.Names.JSFunction"             , values: [term name, term args, term body] }
  term (JSApp fn args)                   = TmCon { con: "Language.PureScript.Names.JSApp"                  , values: [term fn, term args] }
  term (JSVar name)                      = TmCon { con: "Language.PureScript.Names.JSVar"                  , values: [term name] }
  term (JSConditional cond th el)        = TmCon { con: "Language.PureScript.Names.JSConditional"          , values: [term cond, term th, term el] }
  term (JSBlock sts)                     = TmCon { con: "Language.PureScript.Names.JSBlock"                , values: [term sts] }
  term (JSVariableIntroduction name val) = TmCon { con: "Language.PureScript.Names.JSVariableIntroduction" , values: [term name, term val] }
  term (JSAssignment targ val)           = TmCon { con: "Language.PureScript.Names.JSAssignment"           , values: [term targ, term val] }
  term (JSWhile cond sts)                = TmCon { con: "Language.PureScript.Names.JSWhile"                , values: [term cond, term sts] }
  term (JSFor name start end sts)        = TmCon { con: "Language.PureScript.Names.JSFor"                  , values: [term name, term start, term end, term sts] }
  term (JSForIn name obj sts)            = TmCon { con: "Language.PureScript.Names.JSForIn"                , values: [term name, term obj, term sts] }
  term (JSIfElse cond ths els)           = TmCon { con: "Language.PureScript.Names.JSIfElse"               , values: [term cond, term ths, term els] }
  term (JSReturn val)                    = TmCon { con: "Language.PureScript.Names.JSReturn"               , values: [term val] }
  term (JSThrow val)                     = TmCon { con: "Language.PureScript.Names.JSThrow"                , values: [term val] }
  term (JSTypeOf val)                    = TmCon { con: "Language.PureScript.Names.JSTypeOf"               , values: [term val] }
  term (JSLabel name st)                 = TmCon { con: "Language.PureScript.Names.JSLabel"                , values: [term name, term st] }
  term (JSBreak name)                    = TmCon { con: "Language.PureScript.Names.JSBreak"                , values: [term name] }
  term (JSContinue name)                 = TmCon { con: "Language.PureScript.Names.JSContinue"             , values: [term name] }
  term (JSRaw js)                        = TmCon { con: "Language.PureScript.Names.JSRaw"                  , values: [term js] }
  unTerm (TmCon { con = "Language.PureScript.Names.JSNumericLiteral"       , values = [n]                      }) = JSNumericLiteral        <$> unTerm n
  unTerm (TmCon { con = "Language.PureScript.Names.JSStringLiteral"        , values = [s]                      }) = JSStringLiteral         <$> unTerm s
  unTerm (TmCon { con = "Language.PureScript.Names.JSBooleanLiteral"       , values = [b]                      }) = JSBooleanLiteral        <$> unTerm b
  unTerm (TmCon { con = "Language.PureScript.Names.JSUnary"                , values = [op, x]                  }) = JSUnary                 <$> unTerm op <*> unTerm x
  unTerm (TmCon { con = "Language.PureScript.Names.JSBinary"               , values = [op, x, y]               }) = JSBinary                <$> unTerm op <*> unTerm x <*> unTerm y
  unTerm (TmCon { con = "Language.PureScript.Names.JSArrayLiteral"         , values = [es]                     }) = JSArrayLiteral          <$> unTerm es
  unTerm (TmCon { con = "Language.PureScript.Names.JSIndexer"              , values = [prop, val]              }) = JSIndexer               <$> unTerm prop <*> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSObjectLiteral"        , values = [props]                  }) = JSObjectLiteral         <$> unTerm props
  unTerm (TmCon { con = "Language.PureScript.Names.JSAccessor"             , values = [prop, val]              }) = JSAccessor              <$> unTerm prop <*> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSFunction"             , values = [name, args, body]       }) = JSFunction              <$> unTerm name <*> unTerm args <*> unTerm body
  unTerm (TmCon { con = "Language.PureScript.Names.JSApp"                  , values = [fn, args]               }) = JSApp                   <$> unTerm fn <*> unTerm args
  unTerm (TmCon { con = "Language.PureScript.Names.JSVar"                  , values = [name]                   }) = JSVar                   <$> unTerm name
  unTerm (TmCon { con = "Language.PureScript.Names.JSConditional"          , values = [cond, th, el]           }) = JSConditional           <$> unTerm cond <*> unTerm th <*> unTerm el
  unTerm (TmCon { con = "Language.PureScript.Names.JSBlock"                , values = [sts]                    }) = JSBlock                 <$> unTerm sts
  unTerm (TmCon { con = "Language.PureScript.Names.JSVariableIntroduction" , values = [name, val]              }) = JSVariableIntroduction  <$> unTerm name <*> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSAssignment"           , values = [targ, val]              }) = JSAssignment            <$> unTerm targ <*> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSWhile"                , values = [cond, sts]              }) = JSWhile                 <$> unTerm cond <*> unTerm sts
  unTerm (TmCon { con = "Language.PureScript.Names.JSFor"                  , values = [name, start, end, sts]  }) = JSFor                   <$> unTerm name <*> unTerm start <*> unTerm end <*> unTerm sts
  unTerm (TmCon { con = "Language.PureScript.Names.JSForIn"                , values = [name, obj, sts]         }) = JSForIn                 <$> unTerm name <*> unTerm obj <*> unTerm sts
  unTerm (TmCon { con = "Language.PureScript.Names.JSIfElse"               , values = [cond, ths, els]         }) = JSIfElse                <$> unTerm cond <*> unTerm ths <*> unTerm els
  unTerm (TmCon { con = "Language.PureScript.Names.JSReturn"               , values = [val]                    }) = JSReturn                <$> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSThrow"                , values = [val]                    }) = JSThrow                 <$> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSTypeOf"               , values = [val]                    }) = JSTypeOf                <$> unTerm val
  unTerm (TmCon { con = "Language.PureScript.Names.JSLabel"                , values = [name, st]               }) = JSLabel                 <$> unTerm name <*> unTerm st
  unTerm (TmCon { con = "Language.PureScript.Names.JSBreak"                , values = [name]                   }) = JSBreak                 <$> unTerm name
  unTerm (TmCon { con = "Language.PureScript.Names.JSContinue"             , values = [name]                   }) = JSContinue              <$> unTerm name
  unTerm (TmCon { con = "Language.PureScript.Names.JSRaw"                  , values = [js]                     }) = JSRaw                   <$> unTerm js
  unTerm _ = Nothing

module Language.PureScript.CodeGen.JS.AST where

import Prelude
import Data.Either
import Data.Maybe
import Data.Tuple
import Data.Generics

-- |
-- Built-in unary operators
--
data UnaryOperator
  -- |
  -- Numeric negation
  --
  = Negate
  -- |
  -- Boolean negation
  --
  | Not
  -- |
  -- Bitwise negation
  --
  | BitwiseNot
  -- |
  -- Numeric unary \'plus\'
  --
  | Positive

instance showUnaryOperator :: Show UnaryOperator where
  show = gshow

instance eqUnaryOperator :: Eq UnaryOperator where
  (==) = geq
  (/=) x y = not (geq x y)

instance genericUnaryOperator :: Generic UnaryOperator where
  typeOf _ = TyCon { tyCon: "Language.PureScript.CodeGen.JS.AST.UnaryOperator", args: [] }
  term Negate     = TmCon { con: "Language.PureScript.Names.Negate"     , values: [] }
  term Not        = TmCon { con: "Language.PureScript.Names.Not"        , values: [] }
  term BitwiseNot = TmCon { con: "Language.PureScript.Names.BitwiseNot" , values: [] }
  term Positive   = TmCon { con: "Language.PureScript.Names.Positive"   , values: [] }
  unTerm (TmCon { con = "Language.PureScript.Names.Negate"     }) = Just Negate
  unTerm (TmCon { con = "Language.PureScript.Names.Not"        }) = Just Not
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseNot" }) = Just BitwiseNot
  unTerm (TmCon { con = "Language.PureScript.Names.Positive"   }) = Just Positive
  unTerm _ = Nothing

-- |
-- Built-in binary operators
--
data BinaryOperator
  -- |
  -- Numeric addition
  --
  = Add
  -- |
  -- Numeric subtraction
  --
  | Subtract
  -- |
  -- Numeric multiplication
  --
  | Multiply
  -- |
  -- Numeric division
  --
  | Divide
  -- |
  -- Remainder
  --
  | Modulus
  -- |
  -- Generic equality test
  --
  | EqualTo
  -- |
  -- Generic inequality test
  --
  | NotEqualTo
  -- |
  -- Numeric less-than
  --
  | LessThan
  -- |
  -- Numeric less-than-or-equal
  --
  | LessThanOrEqualTo
  -- |
  -- Numeric greater-than
  --
  | GreaterThan
  -- |
  -- Numeric greater-than-or-equal
  --
  | GreaterThanOrEqualTo
  -- |
  -- Boolean and
  --
  | And
  -- |
  -- Boolean or
  --
  | Or
  -- |
  -- Bitwise and
  --
  | BitwiseAnd
  -- |
  -- Bitwise or
  --
  | BitwiseOr
  -- |
  -- Bitwise xor
  --
  | BitwiseXor
  -- |
  -- Bitwise left shift
  --
  | ShiftLeft
  -- |
  -- Bitwise right shift
  --
  | ShiftRight
  -- |
  -- Bitwise right shift with zero-fill
  --
  | ZeroFillShiftRight

instance showBinaryOperator :: Show BinaryOperator where
  show = gshow

instance eqBinaryOperator :: Eq BinaryOperator where
  (==) = geq
  (/=) x y = not (geq x y)

instance genericBinaryOperator :: Generic BinaryOperator where
  typeOf _ = TyCon { tyCon: "Language.PureScript.CodeGen.JS.AST.BinaryOperator", args: [] }
  term Add                  = TmCon { con: "Language.PureScript.Names.Add"                  , values: [] }
  term Subtract             = TmCon { con: "Language.PureScript.Names.Subtract"             , values: [] }
  term Multiply             = TmCon { con: "Language.PureScript.Names.Multiply"             , values: [] }
  term Divide               = TmCon { con: "Language.PureScript.Names.Divide"               , values: [] }
  term Modulus              = TmCon { con: "Language.PureScript.Names.Modulus"              , values: [] }
  term EqualTo              = TmCon { con: "Language.PureScript.Names.EqualTo"              , values: [] }
  term NotEqualTo           = TmCon { con: "Language.PureScript.Names.NotEqualTo"           , values: [] }
  term LessThan             = TmCon { con: "Language.PureScript.Names.LessThan"             , values: [] }
  term LessThanOrEqualTo    = TmCon { con: "Language.PureScript.Names.LessThanOrEqualTo"    , values: [] }
  term GreaterThan          = TmCon { con: "Language.PureScript.Names.GreaterThan"          , values: [] }
  term GreaterThanOrEqualTo = TmCon { con: "Language.PureScript.Names.GreaterThanOrEqualTo" , values: [] }
  term And                  = TmCon { con: "Language.PureScript.Names.And"                  , values: [] }
  term Or                   = TmCon { con: "Language.PureScript.Names.Or"                   , values: [] }
  term BitwiseAnd           = TmCon { con: "Language.PureScript.Names.BitwiseAnd"           , values: [] }
  term BitwiseOr            = TmCon { con: "Language.PureScript.Names.BitwiseOr"            , values: [] }
  term BitwiseXor           = TmCon { con: "Language.PureScript.Names.BitwiseXor"           , values: [] }
  term ShiftLeft            = TmCon { con: "Language.PureScript.Names.ShiftLeft"            , values: [] }
  term ShiftRight           = TmCon { con: "Language.PureScript.Names.ShiftRight"           , values: [] }
  term ZeroFillShiftRight   = TmCon { con: "Language.PureScript.Names.ZeroFillShiftRight"   , values: [] }
  unTerm (TmCon { con = "Language.PureScript.Names.Add"                  }) = Just Add
  unTerm (TmCon { con = "Language.PureScript.Names.Subtract"             }) = Just Subtract
  unTerm (TmCon { con = "Language.PureScript.Names.Multiply"             }) = Just Multiply
  unTerm (TmCon { con = "Language.PureScript.Names.Divide"               }) = Just Divide
  unTerm (TmCon { con = "Language.PureScript.Names.Modulus"              }) = Just Modulus
  unTerm (TmCon { con = "Language.PureScript.Names.EqualTo"              }) = Just EqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.NotEqualTo"           }) = Just NotEqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.LessThan"             }) = Just LessThan
  unTerm (TmCon { con = "Language.PureScript.Names.LessThanOrEqualTo"    }) = Just LessThanOrEqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.GreaterThan"          }) = Just GreaterThan
  unTerm (TmCon { con = "Language.PureScript.Names.GreaterThanOrEqualTo" }) = Just GreaterThanOrEqualTo
  unTerm (TmCon { con = "Language.PureScript.Names.And"                  }) = Just And
  unTerm (TmCon { con = "Language.PureScript.Names.Or"                   }) = Just Or
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseAnd"           }) = Just BitwiseAnd
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseOr"            }) = Just BitwiseOr
  unTerm (TmCon { con = "Language.PureScript.Names.BitwiseXor"           }) = Just BitwiseXor
  unTerm (TmCon { con = "Language.PureScript.Names.ShiftLeft"            }) = Just ShiftLeft
  unTerm (TmCon { con = "Language.PureScript.Names.ShiftRight"           }) = Just ShiftRight
  unTerm (TmCon { con = "Language.PureScript.Names.ZeroFillShiftRight"   }) = Just ZeroFillShiftRight
  unTerm _ = Nothing

-- |
-- Data type for simplified Javascript expressions
--
data JS
  -- |
  -- A numeric literal
  --
  = JSNumericLiteral Number
  -- |
  -- A string literal
  --
  | JSStringLiteral String
  -- |
  -- A boolean literal
  --
  | JSBooleanLiteral Boolean
  -- |
  -- A unary operator application
  --
  | JSUnary UnaryOperator JS
  -- |
  -- A binary operator application
  --
  | JSBinary BinaryOperator JS JS
  -- |
  -- An array literal
  --
  | JSArrayLiteral [JS]
  -- |
  -- An array indexer expression
  --
  | JSIndexer JS JS
  -- |
  -- An object literal
  --
  | JSObjectLiteral [Tuple String JS]
  -- |
  -- An object property accessor expression
  --
  | JSAccessor String JS
  -- |
  -- A function introduction (optional name, arguments, body)
  --
  | JSFunction (Maybe String) [String] JS
  -- |
  -- Function application
  --
  | JSApp JS [JS]
  -- |
  -- Variable
  --
  | JSVar String
  -- |
  -- Conditional expression
  --
  | JSConditional JS JS JS
  -- |
  -- A block of expressions in braces
  --
  | JSBlock [JS]
  -- |
  -- A variable introduction and optional initialization
  --
  | JSVariableIntroduction String (Maybe JS)
  -- |
  -- A variable assignment
  --
  | JSAssignment JS JS
  -- |
  -- While loop
  --
  | JSWhile JS JS
  -- |
  -- For loop
  --
  | JSFor String JS JS JS
  -- |
  -- ForIn loop
  --
  | JSForIn String JS JS
  -- |
  -- If-then-else statement
  --
  | JSIfElse JS JS (Maybe JS)
  -- |
  -- Return statement
  --
  | JSReturn JS
  -- |
  -- Throw statement
  --
  | JSThrow JS
  -- |
  -- Type-Of operator
  --
  | JSTypeOf JS
  -- |
  -- Labelled statement
  --
  | JSLabel String JS
  -- |
  -- Break statement
  --
  | JSBreak String
  -- |
  -- Continue statement
  --
  | JSContinue String
  -- |
  -- Raw Javascript (for an inline foreign import declarations)
  --
  | JSRaw String --deriving (Show, Eq, Data, Typeable)


Fix #73 - Ensure special flags yield truthy values

-- |
-- | Docopt utility surface.
-- |
-- | The impure part of docopt, providing conventient entry
-- | points and functions to use docopt.
-- |

module Docopt (
    run
  , parse
  , defaultOptions
  , DocoptEff ()
  , Options (..)
  , Argv ()
  ) where

import Prelude
import Debug.Trace
import Control.Monad.Aff (Aff)
import Control.Monad.Eff.Exception (error, throwException, EXCEPTION())
import Control.Applicative (liftA1)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Data.Foldable (any, intercalate)
import Data.Either (Either(..), either, fromRight)
import Control.Monad.Eff (Eff())
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Node.FS (FS())
import Node.Process (PROCESS())
import Node.Process as Process
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Console as Console
import Data.String.Regex as Regex
import Data.String.Regex (regex, Regex())
import Text.Wrap (dedent)
import Data.StrMap (StrMap())
import Data.Array as A
import Data.StrMap (lookup)
import Data.Bifunctor (lmap, bimap)
import Data.String.Yarn (lines, unlines)
import Data.String (trim) as String
import Language.Docopt.Errors (developerErrorMessage)
import Language.Docopt.Value (Value(..))
import Partial.Unsafe (unsafePartial)

import Language.Docopt (Docopt, parseDocopt, evalDocopt)
import Language.Docopt.Value (Value())
import Language.Docopt as D
import Language.Docopt.Env (Env())

type Argv = Array String
type DocoptEff e = ( process :: PROCESS
                   , err     :: EXCEPTION
                   , console :: CONSOLE
                   , fs      :: FS
                   | e
                   )

liftEffA :: ∀ e a. Eff (DocoptEff e) a -> Aff (DocoptEff e) a
liftEffA = liftEff

-- |
-- | Options for a docopt run
-- |

type ParseOptionsObj r = {
  smartOptions :: Boolean     -- ^ parse singleton groups as opts if possible
  | r
}

type Options r = {
  argv         :: Maybe Argv   -- ^ override argv. Defaults to `process.argv`
, env          :: Maybe Env    -- ^ override env.  Defaults to `process.env`
, optionsFirst :: Boolean      -- ^ enable "option-first"
, dontExit     :: Boolean      -- ^ don't exit the process upon failure
, smartOptions :: Boolean      -- ^ parse singleton groups as opts if possible
, stopAt       :: Array String -- ^ stop parsing at these custom EOA markers
, requireFlags :: Boolean      -- ^ do not ignore missing flags
, laxPlacement :: Boolean      -- ^ allow positionals/commands to be appear anywhere
, version      :: Maybe String -- ^ the version string to display
, versionFlags :: Array String -- ^ list of flags that trigger 'version'
, helpFlags    :: Array String -- ^ list of flags that trigger 'help'
}

defaultOptions :: Options {}
defaultOptions = {
  argv:         Nothing
, env:          Nothing
, optionsFirst: false
, dontExit:     false
, smartOptions: false
, stopAt:       []
, laxPlacement: false
, requireFlags: false
, version:      Nothing
, versionFlags: [ "--version" ]
, helpFlags:    [ "--help"    ]
}

-- |
-- | Parse the docopt specification from the given help text.
-- |
parse :: ∀ e r
       . String
      -> ParseOptionsObj r
      -> Eff (DocoptEff e) Docopt
parse helpText opts = do
  either (throwException <<< error) pure do
    parseDocopt helpText opts

data Action a
  = ShowHelp String
  | ShowVersion
  | Return a

-- |
-- | Run docopt on the given help text.
-- |
-- | This either succeeds with the key/value mappings or fails with a
-- | descriptive help message.
-- |
run :: ∀ e r
     . Either Docopt String
    -> Options r
    -> Eff (DocoptEff e) (StrMap Value)
run input opts = do
  argv <- maybe (A.drop 2 <$> Process.argv) pure opts.argv
  env  <- maybe Process.getEnv              pure opts.env

  program /\ action <- runEither do
    { program, specification, shortHelp, help } <- case input of
        (Left spec)   -> pure spec
        (Right help') -> parseDocopt help' opts

    bimap
      (fmtHelp program opts.helpFlags shortHelp)
      ((program /\ _) <<< case _ of
        output | canExit && output `has` opts.helpFlags    -> ShowHelp help
        output | canExit && output `has` opts.versionFlags -> ShowVersion
        output                                             -> Return output
      )
      (evalDocopt program specification env argv opts)

  case action of
    Return v      -> pure v
    ShowHelp help -> abort 0 (trimHelp help)
    ShowVersion   -> do
      mVer <- maybe readPkgVersion (pure <<< pure) opts.version
      case mVer of
        Just ver -> abort 0 ver
        Nothing  -> abort 1
          $ program
              <> ": version not detected."
              <> "\n"
              <> developerErrorMessage
      abort 0 ""

  where
    has x = any \s ->
                maybe false (case _ of
                              IntValue  0     -> false
                              BoolValue false -> false
                              ArrayValue []   -> false
                              _               -> true
                              ) (lookup s x)
    canExit = not opts.dontExit

    -- note: purescript needs the `a` for now:
    abort :: ∀ a. _ -> _ -> _ _ a
    abort _ msg | opts.dontExit = throwException (error msg)
    abort code msg
      = let log = if code == 0 then Console.log else Console.error
        in  do
          log msg
          Process.exit code

    runEither = flip either pure (abort 1)

    readPkgVersion = readPkgVersionImpl Just Nothing

    fmtHelp program helpFlags shortHelp errmsg
      = errmsg
      <> "\n"
      <> (dedent $ unlines $ ("  " <> _) <$> lines (dedent shortHelp))
      <> if A.length helpFlags == 0
          then ""
          else "\n" <> "See "
                        <> program <> " " <> (intercalate "/" helpFlags)
                        <> " for more information"

    trimHelp = Regex.replace (regex' "(^\\s*(\r\n|\n|\r))|((\r\n|\n|\r)\\s*$)" "g") ""
    regex' a b = unsafePartial $ fromRight $ regex a (Regex.parseFlags b)

foreign import readPkgVersionImpl
  :: ∀ e
   . (String -> Maybe String)
  -> Maybe String
  -> Eff e (Maybe String)

-- |
-- | Docopt utility surface.
-- |
-- | The impure part of docopt, providing conventient entry
-- | points and functions to use docopt.
-- |

module Docopt (
    run
  , parse
  , defaultOptions
  , DocoptEff ()
  , Options (..)
  , Argv ()
  ) where

import Prelude
import Debug.Trace
import Control.Monad.Aff (Aff)
import Control.Monad.Eff.Exception (error, throwException, EXCEPTION())
import Control.Applicative (liftA1)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Data.Foldable (any, intercalate)
import Data.Either (Either(..), either, fromRight)
import Control.Monad.Eff (Eff())
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Node.FS (FS())
import Node.Process (PROCESS())
import Node.Process as Process
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Console as Console
import Data.String.Regex as Regex
import Data.String.Regex (regex, Regex())
import Text.Wrap (dedent)
import Data.StrMap (StrMap())
import Data.Array as A
import Data.StrMap (member)
import Data.Bifunctor (lmap, bimap)
import Data.String.Yarn (lines, unlines)
import Data.String (trim) as String
import Language.Docopt.Errors (developerErrorMessage)
import Partial.Unsafe (unsafePartial)

import Language.Docopt (Docopt, parseDocopt, evalDocopt)
import Language.Docopt.Value (Value())
import Language.Docopt as D
import Language.Docopt.Env (Env())

type Argv = Array String
type DocoptEff e = ( process :: PROCESS
                   , err     :: EXCEPTION
                   , console :: CONSOLE
                   , fs      :: FS
                   | e
                   )

liftEffA :: ∀ e a. Eff (DocoptEff e) a -> Aff (DocoptEff e) a
liftEffA = liftEff

-- |
-- | Options for a docopt run
-- |

type ParseOptionsObj r = {
  smartOptions :: Boolean     -- ^ parse singleton groups as opts if possible
  | r
}

type Options r = {
  argv         :: Maybe Argv   -- ^ override argv. Defaults to `process.argv`
, env          :: Maybe Env    -- ^ override env.  Defaults to `process.env`
, optionsFirst :: Boolean      -- ^ enable "option-first"
, dontExit     :: Boolean      -- ^ don't exit the process upon failure
, smartOptions :: Boolean      -- ^ parse singleton groups as opts if possible
, stopAt       :: Array String -- ^ stop parsing at these custom EOA markers
, requireFlags :: Boolean      -- ^ do not ignore missing flags
, laxPlacement :: Boolean      -- ^ allow positionals/commands to be appear anywhere
, version      :: Maybe String -- ^ the version string to display
, versionFlags :: Array String -- ^ list of flags that trigger 'version'
, helpFlags    :: Array String -- ^ list of flags that trigger 'help'
}

defaultOptions :: Options {}
defaultOptions = {
  argv:         Nothing
, env:          Nothing
, optionsFirst: false
, dontExit:     false
, smartOptions: false
, stopAt:       []
, laxPlacement: false
, requireFlags: false
, version:      Nothing
, versionFlags: [ "--version" ]
, helpFlags:    [ "--help"    ]
}

-- |
-- | Parse the docopt specification from the given help text.
-- |
parse :: ∀ e r
       . String
      -> ParseOptionsObj r
      -> Eff (DocoptEff e) Docopt
parse helpText opts = do
  either (throwException <<< error) pure do
    parseDocopt helpText opts

data Action a
  = ShowHelp String
  | ShowVersion
  | Return a

-- |
-- | Run docopt on the given help text.
-- |
-- | This either succeeds with the key/value mappings or fails with a
-- | descriptive help message.
-- |
run :: ∀ e r
     . Either Docopt String
    -> Options r
    -> Eff (DocoptEff e) (StrMap Value)
run input opts = do
  argv <- maybe (A.drop 2 <$> Process.argv) pure opts.argv
  env  <- maybe Process.getEnv              pure opts.env

  program /\ action <- runEither do
    { program, specification, shortHelp, help } <- case input of
        (Left spec)   -> pure spec
        (Right help') -> parseDocopt help' opts

    bimap
      (fmtHelp program opts.helpFlags shortHelp)
      ((program /\ _) <<< case _ of
        output | canExit && output `has` opts.helpFlags    -> ShowHelp help
        output | canExit && output `has` opts.versionFlags -> ShowVersion
        output                                             -> Return output
      )
      (evalDocopt program specification env argv opts)

  case action of
    Return v      -> pure v
    ShowHelp help -> abort 0 (trimHelp help)
    ShowVersion   -> do
      mVer <- maybe readPkgVersion (pure <<< pure) opts.version
      case mVer of
        Just ver -> abort 0 ver
        Nothing  -> abort 1
          $ program
              <> ": version not detected."
              <> "\n"
              <> developerErrorMessage
      abort 0 ""

  where
    has x = any (_ `member` x)
    canExit = not opts.dontExit

    -- note: purescript needs the `a` for now:
    abort :: ∀ a. _ -> _ -> _ _ a
    abort _ msg | opts.dontExit = throwException (error msg)
    abort code msg
      = let log = if code == 0 then Console.log else Console.error
        in  do
          log msg
          Process.exit code

    runEither = flip either pure (abort 1)

    readPkgVersion = readPkgVersionImpl Just Nothing

    fmtHelp program helpFlags shortHelp errmsg
      = errmsg
      <> "\n"
      <> (dedent $ unlines $ ("  " <> _) <$> lines (dedent shortHelp))
      <> if A.length helpFlags == 0
          then ""
          else "\n" <> "See "
                        <> program <> " " <> (intercalate "/" helpFlags)
                        <> " for more information"

    trimHelp = Regex.replace (regex' "(^\\s*(\r\n|\n|\r))|((\r\n|\n|\r)\\s*$)" "g") ""
    regex' a b = unsafePartial $ fromRight $ regex a (Regex.parseFlags b)

foreign import readPkgVersionImpl
  :: ∀ e
   . (String -> Maybe String)
  -> Maybe String
  -> Eff e (Maybe String)


add body to Fetch.Options

add body to Fetch.Options

module Fetch.Options
  ( FetchOptions
  , Method(..)
  , body
  , defaults
  , headers
  , method
  , url
  ) where

import Prelude (show)
import Data.Show (class Show)
import Data.Functor.Contravariant (cmap)
import Data.Options (Option, Options, defaultToOptions, opt)
import Data.StrMap (StrMap)

data Method = DELETE | GET | HEAD | PATCH | POST | PUT

instance showMethod :: Show Method where
  show DELETE = "DELETE"
  show GET = "GET"
  show HEAD = "HEAD"
  show PATCH = "PATCH"
  show POST = "POST"
  show PUT = "PUT"

data FetchOptions

body :: Option FetchOptions String
body = opt "body"

defaults :: Options FetchOptions
defaults = defaultToOptions "method" GET

headers :: Option FetchOptions (StrMap String)
headers = opt "headers"

method :: Option FetchOptions Method
method = cmap show (opt "method")

url :: Option FetchOptions String
url = opt "url"

module Fetch.Options
  ( FetchOptions
  , Method(..)
  , defaults
  , headers
  , method
  , url
  ) where

import Prelude (show)
import Data.Show (class Show)
import Data.Functor.Contravariant (cmap)
import Data.Options (Option, Options, defaultToOptions, options, opt)
import Data.StrMap (StrMap)

data Method = DELETE | GET | HEAD | PATCH | POST | PUT

instance showMethod :: Show Method where
  show DELETE = "DELETE"
  show GET = "GET"
  show HEAD = "HEAD"
  show PATCH = "PATCH"
  show POST = "POST"
  show PUT = "PUT"

data FetchOptions

defaults :: Options FetchOptions
defaults = defaultToOptions "method" GET

headers :: Option FetchOptions (StrMap String)
headers = opt "headers"

method :: Option FetchOptions Method
method = cmap show (opt "method")

url :: Option FetchOptions String
url = opt "url"