extract file element, filter by watched

extract file element, filter by watched

module FrontEnd where

import Prelude

import ChocoPie (runChocoPie)
import Data.Array as Array
import Data.Either (Either(..), hush)
import Data.Foldable (intercalate, maximumBy)
import Data.Function (on)
import Data.Int as Int
import Data.Maybe (Maybe(..), fromMaybe, isJust, isNothing, maybe)
import Data.Newtype (class Newtype, un)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, makeAff)
import Effect.Class (liftEffect)
import Effect.Class.Console as Console
import Effect.Uncurried (EffectFn1)
import FRP.Event (Event)
import FRP.Event as Event
import Global.Unsafe (unsafeEncodeURIComponent)
import Milkis as M
import Milkis.Impl.Window (windowFetch)
import NameParser (nameParser)
import React.Basic as RB
import React.Basic.DOM as R
import React.Basic.DOM.Events as RE
import React.Basic.Events (SyntheticEvent)
import React.Basic.Events as Events
import Routes (GetRoute, PostRoute, apiRoutes)
import Simple.JSON as JSON
import Text.Parsing.StringParser (runParser)
import Type.Prelude (class IsSymbol, SProxy(..), reflectSymbol)
import Types (Path(..), WatchedData)

newtype DateString = DateString String
derive instance newtypeDateString :: Newtype DateString _

type File =
  { name :: Path
  , watched :: Maybe DateString
  , series :: Maybe String
  , episode :: Maybe Int
  , latest :: Maybe Int
  }

type State =
  -- files
  { files :: Array File
  , filesData :: Array Path
  , watchedData :: Array WatchedData
  , filesLoading :: Boolean
  , iconsLoading :: Boolean
  , grouped :: Boolean
  , filterWatched :: Boolean
  -- counted by positions from the top
  , cursor :: Maybe Int
  }

data Action
  = FetchData
  | UpdateFiles
  | OpenFile
  | MarkFile
  | ToggleWatched Path
  | SetCursor Int
  | LinkClick Int
  | WatchedClick Int
  | EEQuery ExternalEvent

initialState :: State
initialState =
  { files: []
  , filesData: []
  , watchedData: []
  , filesLoading: false
  , iconsLoading: false
  , grouped: false
  , filterWatched: false
  , cursor: Nothing
  }

type Props = {}

type Self = RB.Self Props State

div' :: String -> Array RB.JSX -> RB.JSX
div' className children = R.div { className, children }

capture_ :: Aff Unit -> EffectFn1 SyntheticEvent Unit
capture_ = RE.capture_ <<< launchAff_

handler_ :: Aff Unit -> EffectFn1 SyntheticEvent Unit
handler_ = Events.handler_ <<< launchAff_

readState' :: Self -> Aff State
readState' = liftEffect <<< RB.readState

mkIconURL :: String -> String
mkIconURL series = "url(\"" <> un M.URL (prefixUrl $ iconsPath) <> "\")"
  where iconsPath = "/icons/" <> unsafeEncodeURIComponent series

render :: Self -> RB.JSX
render self@{state} =
  R.div_
    [ R.h1_ [R.text "vidtracker"]
    , header
    , R.div_ $ Array.mapWithIndex mkFile files
    ]
  where
    groupedFiles = if state.grouped
      then Array.sortBy (on compare _.series <> on compare _.episode)
      else identity

    filterWatched = if state.filterWatched
      then Array.filter (isNothing <<< _.watched)
      else identity

    files = filterWatched $ groupedFiles state.files

    header = div' "header"
      [ div' "info" $ [ R.h3_ [ R.text "Info:" ] ] <> infoLines
      , div' "recents" $ [ R.h3_ [ R.text "Recently watched:" ] ] <> recents
      ]

    infoLines = R.span_ <<< pure <<< R.text <$>
      [ "o: open current file"
      , "k: move cursor up"
      , "j: move cursor down"
      , "W/M: mark as watched"
      , "r: refresh"
      , "I: fetch icons and reload page"
      , "files loading: " <> if state.filesLoading then "true" else "false"
      , "icons loading: " <> if state.iconsLoading then "true" else "false"
      , "grouped by series: " <> if state.grouped then "true" else "false"
      , "filtering watched: " <> if state.filterWatched then "true" else "false"
      ]

    recents = mkRecent <$> Array.take (Array.length infoLines) state.watchedData

    mkRecent { path: Path name } = div' "recent" [ R.text name ]

    mkFile :: Int -> File -> RB.JSX
    mkFile idx file = RB.keyed (un Path file.name) $ fileElement idx file self

fileElement :: Int -> File -> Self -> RB.JSX
fileElement idx file self =
  let
    state = self.state
  in
    R.div
      { className: intercalate " "
          [ "file"
          , case state.cursor of
              Just pos | pos == idx -> "cursor"
              _ -> ""
          , case file.watched of
              Just _ -> "done"
              Nothing -> ""
          ]
      , title : "latest watched: " <> fromMaybe "unknown" (show <$> file.latest)
      , onClick: handler_ $ eval self (SetCursor idx)
      , children:
          [ R.div
              { className: "icon"
              , style:
                  case file.series of
                    Just series -> R.css { backgroundImage: mkIconURL series }
                    Nothing -> R.css {}
              }
          , R.div
              { className: "name"
              , title: (un Path file.name)
              , children: [ R.text $ un Path file.name ]
              , onClick: capture_ $ eval self (LinkClick idx)
              }
          , R.div
              { className: intercalate " "
                [ "watched"
                , maybe "" (const "has-date") file.watched
                ]
              , onClick: capture_ $ eval self (WatchedClick idx)
              , children:
                  [ R.text $ case file.watched of
                      Just (DateString date) -> "watched " <> date
                      Nothing -> maybe "" (\x -> " last: " <> show x) file.latest
                  ]
              }
        ]
    }

eval :: Self -> Action -> Aff Unit

eval self (LinkClick idx) = do
  eval self (SetCursor idx)
  eval self OpenFile

eval self (WatchedClick idx) = do
  eval self (SetCursor idx)
  eval self MarkFile

eval self FetchData = do
  setStateAff self _ { filesLoading = true }
  attempt <- getData
  liftEffect $ case attempt of
    Right r -> self.setState _
      { filesData = r.filesData
      , watchedData = r.watchedData
      , filesLoading = false
      }
    Left e -> Console.error $ "Failed to fetch data: " <> show e
  eval self UpdateFiles
  where
    getData = do
      filesData <- get apiRoutes.files
      watchedData <- get apiRoutes.watched
      pure $ { filesData: _, watchedData: _ }
        <$> filesData
        <*> watchedData

eval self UpdateFiles = do
  setStateAff self \s -> do
    let files = mkFile s.watchedData <$> s.filesData
    let annotated = annotateLatest files
    if s.grouped
      then s { files = groupFiles annotated }
      else s { files = annotated }
  where
    mkFile watched file@(Path name) =
      { name: Path name
      , watched: DateString <<< _.created <$> Array.find (\x -> x.path == file) watched
      , series: _.name <$> parsed
      , episode: Int.fromString <<< _.episode =<< parsed
      , latest: Nothing
      } :: File
      where
        parsed = hush $ runParser nameParser name

    annotateLatest :: Array File -> Array File
    annotateLatest xs = updateLatest <$> xs
      where
        watchedFiles :: Array File
        watchedFiles = Array.filter (\x -> isJust x.watched) xs

        grouped :: Array (Maybe File)
        grouped
            = maximumBy (compare `on` _.episode)
          <$> Array.groupBy (eq `on` _.series)
              (Array.sortWith _.series watchedFiles)
        updateLatest x
          | match' <- \z -> z.series == x.series
          , match <- \y -> maybe false match' y
          , Just (Just y) <- Array.find match grouped
            = x { latest = y.episode }
          | otherwise = x

    groupFiles = Array.sortBy
      (\x y
        -> compare x.series y.series
        <> compare x.episode y.episode
      )

eval self (ToggleWatched name) = do
  state <- readState' self
  Console.log $ "Updating " <> un Path name
  case Array.find (\x -> x.name == name) state.files of
    Just file -> do
      _ <- post apiRoutes.update
        { path: file.name
        , watched: maybe true (const false) file.watched
        }
      pure unit
    Nothing -> Console.error $ "Could not find file named " <> un Path name
  eval self FetchData

eval self (SetCursor idx) = do
  setStateAff self _ { cursor = Just idx }

eval self (EEQuery (DirectionEvent dir)) = do
  liftEffect case dir of
    Down -> self.setState \s -> do
      let cursor = min (Array.length s.files) (maybe 0 (_ + 1) s.cursor)
      s { cursor = Just cursor }
    Up -> self.setState \s -> do
      let cursor = max 0 (maybe 0 (_ - 1) s.cursor)
      s { cursor = Just cursor }

  newState <- liftEffect $ RB.readState self
  case newState.cursor of
    Just cursor | cursor == 0 -> liftEffect $ scrollToTop
    Just cursor | Just file <- Array.index newState.files =<< newState.cursor -> do
      liftEffect $ scrollIntoView file.name
    _ -> pure unit

eval self OpenFile = do
  state <- readState' self
  case state.cursor of
    Just pos
      | Just file <- Array.index state.files pos
      -> do
      Console.log $ "Opening file: " <> un Path file.name
      _ <- post apiRoutes.open { path: file.name }
      pure unit
    _ -> pure unit

eval self (EEQuery OpenEvent) = eval self OpenFile

eval self MarkFile = do
  state <- readState' self
  case state.cursor of
    Just pos
      | Just file <- Array.index state.files pos
      -> eval self (ToggleWatched file.name)
    _ -> pure unit

eval self (EEQuery MarkEvent) = eval self MarkFile

eval self (EEQuery RefreshEvent) = do
  Console.log "RefreshEvent"
  eval self FetchData

eval self (EEQuery FetchIconsEvent) = do
  Console.log "FetchIconsEvent"
  setStateAff self _ { iconsLoading = true }
  result <- post apiRoutes.getIcons {}
  setStateAff self _ { iconsLoading = false }
  liftEffect $ refreshPage

eval self (EEQuery ToggleGroupedEvent) = do
  setStateAff self \s -> s { grouped = not s.grouped }
  eval self UpdateFiles

eval self (EEQuery ToggleFilterWatched) = do
  setStateAff self \s -> s { filterWatched = not s.filterWatched }
  eval self UpdateFiles

_ui :: RB.Component Props
_ui = RB.createComponent "UI"

mkUI :: Event ExternalEvent -> Props -> RB.JSX
mkUI externalEvents = RB.make _ui
  { initialState: initialState
  , render: render
  , didMount: \self -> do
      _ <- Event.subscribe externalEvents \ee -> do
        launchAff_ $ eval self (EEQuery ee)
      launchAff_ $ eval self FetchData
  }

data ExternalEvent
  -- move cursor on j/k
  = DirectionEvent Direction
  -- open file on o
  | OpenEvent
  -- mark file watched on m
  | MarkEvent
  -- call refresh files on r
  | RefreshEvent
  -- call fetch icons on I (shift + i)
  | FetchIconsEvent
  -- toggle grouping by show name
  | ToggleGroupedEvent
  -- toggle filtering watched items
  | ToggleFilterWatched

data Direction = Up | Down

keyboard :: Event Unit -> Effect (Event ExternalEvent)
keyboard _ = do
  {event, push} <- Event.create
  addWindowKeyListener \key ->
    case key of
      "o" -> push OpenEvent
      "k" -> push $ DirectionEvent Up
      "j" -> push $ DirectionEvent Down
      "f" -> push ToggleFilterWatched
      "W" -> push MarkEvent
      "M" -> push MarkEvent
      "r" -> push RefreshEvent
      "I" -> push FetchIconsEvent
      "g" -> push ToggleGroupedEvent
      _ -> pure unit
  pure event

view :: Event ExternalEvent -> Effect (Event Unit)
view externalEvents = do
  renderJSX (mkUI externalEvents {})
  mempty

main :: Effect Unit
main = do
  liftEffect $ runChocoPie mkSink drivers
  Console.log "Started application"
  where
    mkSink sources =
      { keyboard: mempty :: Event Unit
      , view: sources.keyboard
      }
    drivers = {keyboard, view}

setStateAff :: Self -> (State -> State) -> Aff Unit
setStateAff self fn = makeAff \cb -> do
  self.setStateThen fn do cb (Right unit)
  mempty

foreign import renderJSX :: RB.JSX -> Effect Unit

foreign import refreshPage :: Effect Unit

foreign import addWindowKeyListener :: (String -> Effect Unit) -> Effect Unit

foreign import scrollIntoView :: Path -> Effect Unit

foreign import scrollToTop :: Effect Unit

prefixUrl :: String -> M.URL
prefixUrl url = M.URL $ "http://localhost:3000" <> url

get :: forall res url. JSON.ReadForeign res => IsSymbol url => GetRoute res url -> Aff (JSON.E res)
get _ = JSON.read <$> action
  where
    url = reflectSymbol (SProxy :: SProxy url)
    fetch = M.fetch windowFetch
    action = M.json =<< fetch (prefixUrl url) M.defaultFetchOptions

post :: forall req res url. JSON.WriteForeign req => JSON.ReadForeign res => IsSymbol url =>
  PostRoute req res url -> req -> Aff (JSON.E res)
post _ body = JSON.read <$> action
  where
    url = reflectSymbol (SProxy :: SProxy url)
    fetch = M.fetch windowFetch
    options =
      { method: M.postMethod
      , headers: M.makeHeaders { "Content-Type": "application/json" }
      , body: JSON.writeJSON body
      }
    action = M.json =<< fetch (prefixUrl url) options

module FrontEnd where

import Prelude

import ChocoPie (runChocoPie)
import Data.Array as Array
import Data.Either (Either(..), hush)
import Data.Foldable (intercalate, maximumBy)
import Data.Function (on)
import Data.Int as Int
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Newtype (class Newtype, un)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, makeAff)
import Effect.Class (liftEffect)
import Effect.Class.Console as Console
import Effect.Uncurried (EffectFn1)
import FRP.Event (Event)
import FRP.Event as Event
import Global.Unsafe (unsafeEncodeURIComponent)
import Milkis as M
import Milkis.Impl.Window (windowFetch)
import NameParser (nameParser)
import React.Basic as RB
import React.Basic.DOM as R
import React.Basic.DOM.Events as RE
import React.Basic.Events (SyntheticEvent)
import React.Basic.Events as Events
import Routes (GetRoute, PostRoute, apiRoutes)
import Simple.JSON as JSON
import Text.Parsing.StringParser (runParser)
import Type.Prelude (class IsSymbol, SProxy(..), reflectSymbol)
import Types (Path(..), WatchedData)

newtype DateString = DateString String
derive instance newtypeDateString :: Newtype DateString _

type File =
  { name :: Path
  , watched :: Maybe DateString
  , series :: Maybe String
  , episode :: Maybe Int
  , latest :: Maybe Int
  }

type State =
  -- files
  { files :: Array File
  , filesData :: Array Path
  , watchedData :: Array WatchedData
  , filesLoading :: Boolean
  , iconsLoading :: Boolean
  , grouped :: Boolean
  -- counted by positions from the top
  , cursor :: Maybe Int
  }

data Action
  = FetchData
  | UpdateFiles
  | OpenFile
  | MarkFile
  | ToggleWatched Path
  | SetCursor Int
  | LinkClick Int
  | WatchedClick Int
  | EEQuery ExternalEvent

initialState :: State
initialState =
  { files: []
  , filesData: []
  , watchedData: []
  , filesLoading: false
  , iconsLoading: false
  , grouped: false
  , cursor: Nothing
  }

type Props = {}

type Self = RB.Self Props State

div' :: String -> Array RB.JSX -> RB.JSX
div' className children = R.div { className, children }

capture_ :: Aff Unit -> EffectFn1 SyntheticEvent Unit
capture_ = RE.capture_ <<< launchAff_

handler_ :: Aff Unit -> EffectFn1 SyntheticEvent Unit
handler_ = Events.handler_ <<< launchAff_

readState' :: Self -> Aff State
readState' = liftEffect <<< RB.readState

mkIconURL :: String -> String
mkIconURL series = "url(\"" <> un M.URL (prefixUrl $ iconsPath) <> "\")"
  where iconsPath = "/icons/" <> unsafeEncodeURIComponent series

render :: Self -> RB.JSX
render self@{state} =
  R.div_
    [ R.h1_ [R.text "vidtracker"]
    , header
    , R.div_ $ Array.mapWithIndex mkFile files
    ]
  where
    files = if state.grouped
      then Array.sortBy
        (\x y -> compare x.series y.series <> compare x.episode y.episode)
        state.files
      else state.files

    header = div' "header"
      [ div' "info" $ [ R.h3_ [ R.text "Info:" ] ] <> infoLines
      , div' "recents" $ [ R.h3_ [ R.text "Recently watched:" ] ] <> recents
      ]

    infoLines = R.span_ <<< pure <<< R.text <$>
      [ "o: open current file"
      , "k: move cursor up"
      , "j: move cursor down"
      , "W/M: mark as watched"
      , "r: refresh"
      , "I: fetch icons and reload page"
      , "files loading: " <> if state.filesLoading then "true" else "false"
      , "icons loading: " <> if state.iconsLoading then "true" else "false"
      , "grouped by series: " <> if state.grouped then "true" else "false"
      ]

    recents = mkRecent <$> Array.take (Array.length infoLines) state.watchedData

    mkRecent { path: Path name } = div' "recent" [ R.text name ]

    mkFile :: Int -> File -> _
    mkFile idx file = R.div
      { className: intercalate " "
          [ "file"
          , case state.cursor of
              Just pos | pos == idx -> "cursor"
              _ -> ""
          , case file.watched of
              Just _ -> "done"
              Nothing -> ""
          ]
      , title : "latest watched: " <> fromMaybe "unknown" (show <$> file.latest)
      , onClick: handler_ $ eval self (SetCursor idx)
      , children:
          [ R.div
              { className: "icon"
              , style:
                  case file.series of
                    Just series -> R.css { backgroundImage: mkIconURL series }
                    Nothing -> R.css {}
              }
          , R.div
              { className: "name"
              , title: (un Path file.name)
              , children: [ R.text $ un Path file.name ]
              , onClick: capture_ $ eval self (LinkClick idx)
              }
          , R.div
              { className: intercalate " "
                [ "watched"
                , maybe "" (const "has-date") file.watched
                ]
              , onClick: capture_ $ eval self (WatchedClick idx)
              , children:
                  [ R.text $ case file.watched of
                      Just (DateString date) -> "watched " <> date
                      Nothing -> maybe "" (\x -> " last: " <> show x) file.latest
                  ]
              }
        ]
    }

eval :: Self -> Action -> Aff Unit

eval self (LinkClick idx) = do
  eval self (SetCursor idx)
  eval self OpenFile

eval self (WatchedClick idx) = do
  eval self (SetCursor idx)
  eval self MarkFile

eval self FetchData = do
  setStateAff self _ { filesLoading = true }
  attempt <- getData
  liftEffect $ case attempt of
    Right r -> self.setState _
      { filesData = r.filesData
      , watchedData = r.watchedData
      , filesLoading = false
      }
    Left e -> Console.error $ "Failed to fetch data: " <> show e
  eval self UpdateFiles
  where
    getData = do
      filesData <- get apiRoutes.files
      watchedData <- get apiRoutes.watched
      pure $ { filesData: _, watchedData: _ }
        <$> filesData
        <*> watchedData

eval self UpdateFiles = do
  setStateAff self \s -> do
    let files = mkFile s.watchedData <$> s.filesData
    let annotated = annotateLatest files
    if s.grouped
      then s { files = groupFiles annotated }
      else s { files = annotated }
  where
    mkFile watched file@(Path name) =
      { name: Path name
      , watched: DateString <<< _.created <$> Array.find (\x -> x.path == file) watched
      , series: _.name <$> parsed
      , episode: Int.fromString <<< _.episode =<< parsed
      , latest: Nothing
      } :: File
      where
        parsed = hush $ runParser nameParser name

    annotateLatest :: Array File -> Array File
    annotateLatest xs = updateLatest <$> xs
      where
        watchedFiles :: Array File
        watchedFiles = Array.filter (\x -> isJust x.watched) xs

        grouped :: Array (Maybe File)
        grouped
            = maximumBy (compare `on` _.episode)
          <$> Array.groupBy (eq `on` _.series)
              (Array.sortWith _.series watchedFiles)
        updateLatest x
          | match' <- \z -> z.series == x.series
          , match <- \y -> maybe false match' y
          , Just (Just y) <- Array.find match grouped
            = x { latest = y.episode }
          | otherwise = x

    groupFiles = Array.sortBy
      (\x y
        -> compare x.series y.series
        <> compare x.episode y.episode
      )

eval self (ToggleWatched name) = do
  state <- readState' self
  Console.log $ "Updating " <> un Path name
  case Array.find (\x -> x.name == name) state.files of
    Just file -> do
      _ <- post apiRoutes.update
        { path: file.name
        , watched: maybe true (const false) file.watched
        }
      pure unit
    Nothing -> Console.error $ "Could not find file named " <> un Path name
  eval self FetchData

eval self (SetCursor idx) = do
  setStateAff self _ { cursor = Just idx }

eval self (EEQuery (DirectionEvent dir)) = do
  liftEffect case dir of
    Down -> self.setState \s -> do
      let cursor = min (Array.length s.files) (maybe 0 (_ + 1) s.cursor)
      s { cursor = Just cursor }
    Up -> self.setState \s -> do
      let cursor = max 0 (maybe 0 (_ - 1) s.cursor)
      s { cursor = Just cursor }

  newState <- liftEffect $ RB.readState self
  case newState.cursor of
    Just cursor | cursor == 0 -> liftEffect $ scrollToTop
    Just cursor | Just file <- Array.index newState.files =<< newState.cursor -> do
      liftEffect $ scrollIntoView file.name
    _ -> pure unit

eval self OpenFile = do
  state <- readState' self
  case state.cursor of
    Just pos
      | Just file <- Array.index state.files pos
      -> do
      Console.log $ "Opening file: " <> un Path file.name
      _ <- post apiRoutes.open { path: file.name }
      pure unit
    _ -> pure unit

eval self (EEQuery OpenEvent) = eval self OpenFile

eval self MarkFile = do
  state <- readState' self
  case state.cursor of
    Just pos
      | Just file <- Array.index state.files pos
      -> eval self (ToggleWatched file.name)
    _ -> pure unit

eval self (EEQuery MarkEvent) = eval self MarkFile

eval self (EEQuery RefreshEvent) = do
  Console.log "RefreshEvent"
  eval self FetchData

eval self (EEQuery FetchIconsEvent) = do
  Console.log "FetchIconsEvent"
  setStateAff self _ { iconsLoading = true }
  result <- post apiRoutes.getIcons {}
  setStateAff self _ { iconsLoading = false }
  liftEffect $ refreshPage

eval self (EEQuery ToggleGroupedEvent) = do
  setStateAff self \s -> s { grouped = not s.grouped }
  eval self UpdateFiles

_ui :: RB.Component Props
_ui = RB.createComponent "UI"

mkUI :: Event ExternalEvent -> Props -> RB.JSX
mkUI externalEvents = RB.make _ui
  { initialState: initialState
  , render: render
  , didMount: \self -> do
      _ <- Event.subscribe externalEvents \ee -> do
        launchAff_ $ eval self (EEQuery ee)
      launchAff_ $ eval self FetchData
  }

data ExternalEvent
  -- move cursor on j/k
  = DirectionEvent Direction
  -- open file on o
  | OpenEvent
  -- mark file watched on m
  | MarkEvent
  -- call refresh files on r
  | RefreshEvent
  -- call fetch icons on I (shift + i)
  | FetchIconsEvent
  -- toggle grouping by show name
  | ToggleGroupedEvent

data Direction = Up | Down

keyboard :: Event Unit -> Effect (Event ExternalEvent)
keyboard _ = do
  {event, push} <- Event.create
  addWindowKeyListener \key ->
    case key of
      "o" -> push OpenEvent
      "k" -> push $ DirectionEvent Up
      "j" -> push $ DirectionEvent Down
      "W" -> push MarkEvent
      "M" -> push MarkEvent
      "r" -> push RefreshEvent
      "I" -> push FetchIconsEvent
      "g" -> push ToggleGroupedEvent
      _ -> pure unit
  pure event

view :: Event ExternalEvent -> Effect (Event Unit)
view externalEvents = do
  renderJSX (mkUI externalEvents {})
  mempty

main :: Effect Unit
main = do
  liftEffect $ runChocoPie mkSink drivers
  Console.log "Started application"
  where
    mkSink sources =
      { keyboard: mempty :: Event Unit
      , view: sources.keyboard
      }
    drivers = {keyboard, view}

setStateAff :: Self -> (State -> State) -> Aff Unit
setStateAff self fn = makeAff \cb -> do
  self.setStateThen fn do cb (Right unit)
  mempty

foreign import renderJSX :: RB.JSX -> Effect Unit

foreign import refreshPage :: Effect Unit

foreign import addWindowKeyListener :: (String -> Effect Unit) -> Effect Unit

foreign import scrollIntoView :: Path -> Effect Unit

foreign import scrollToTop :: Effect Unit

prefixUrl :: String -> M.URL
prefixUrl url = M.URL $ "http://localhost:3000" <> url

get :: forall res url. JSON.ReadForeign res => IsSymbol url => GetRoute res url -> Aff (JSON.E res)
get _ = JSON.read <$> action
  where
    url = reflectSymbol (SProxy :: SProxy url)
    fetch = M.fetch windowFetch
    action = M.json =<< fetch (prefixUrl url) M.defaultFetchOptions

post :: forall req res url. JSON.WriteForeign req => JSON.ReadForeign res => IsSymbol url =>
  PostRoute req res url -> req -> Aff (JSON.E res)
post _ body = JSON.read <$> action
  where
    url = reflectSymbol (SProxy :: SProxy url)
    fetch = M.fetch windowFetch
    options =
      { method: M.postMethod
      , headers: M.makeHeaders { "Content-Type": "application/json" }
      , body: JSON.writeJSON body
      }
    action = M.json =<< fetch (prefixUrl url) options


Fix shadowed name warnings in `indexl` / `indexr`

module Data.Foldable
  ( class Foldable, foldr, foldl, foldMap
  , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR
  , fold
  , foldM
  , traverse_
  , for_
  , sequence_
  , oneOf
  , oneOfMap
  , intercalate
  , surroundMap
  , surround
  , and
  , or
  , all
  , any
  , sum
  , product
  , elem
  , notElem
  , indexl
  , indexr
  , find
  , findMap
  , maximum
  , maximumBy
  , minimum
  , minimumBy
  , null
  , length
  ) where

import Prelude

import Control.Plus (class Plus, alt, empty)

import Data.Maybe (Maybe(..))
import Data.Maybe.First (First(..))
import Data.Maybe.Last (Last(..))
import Data.Monoid (class Monoid, mempty)
import Data.Monoid.Additive (Additive(..))
import Data.Monoid.Conj (Conj(..))
import Data.Monoid.Disj (Disj(..))
import Data.Monoid.Dual (Dual(..))
import Data.Monoid.Endo (Endo(..))
import Data.Monoid.Multiplicative (Multiplicative(..))
import Data.Newtype (alaF, unwrap)

-- | `Foldable` represents data structures which can be _folded_.
-- |
-- | - `foldr` folds a structure from the right
-- | - `foldl` folds a structure from the left
-- | - `foldMap` folds a structure by accumulating values in a `Monoid`
-- |
-- | Default implementations are provided by the following functions:
-- |
-- | - `foldrDefault`
-- | - `foldlDefault`
-- | - `foldMapDefaultR`
-- | - `foldMapDefaultL`
-- |
-- | Note: some combinations of the default implementations are unsafe to
-- | use together - causing a non-terminating mutually recursive cycle.
-- | These combinations are documented per function.
class Foldable f where
  foldr :: forall a b. (a -> b -> b) -> b -> f a -> b
  foldl :: forall a b. (b -> a -> b) -> b -> f a -> b
  foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m

-- | A default implementation of `foldr` using `foldMap`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldMapDefaultR`.
foldrDefault
  :: forall f a b
   . Foldable f
  => (a -> b -> b)
  -> b
  -> f a
  -> b
foldrDefault c u xs = unwrap (foldMap (Endo <<< c) xs) u

-- | A default implementation of `foldl` using `foldMap`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldMapDefaultL`.
foldlDefault
  :: forall f a b
   . Foldable f
  => (b -> a -> b)
  -> b
  -> f a
  -> b
foldlDefault c u xs = unwrap (unwrap (foldMap (Dual <<< Endo <<< flip c) xs)) u

-- | A default implementation of `foldMap` using `foldr`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldrDefault`.
foldMapDefaultR
  :: forall f a m
   . Foldable f
  => Monoid m
  => (a -> m)
  -> f a
  -> m
foldMapDefaultR f = foldr (\x acc -> f x <> acc) mempty

-- | A default implementation of `foldMap` using `foldl`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldlDefault`.
foldMapDefaultL
  :: forall f a m
   . Foldable f
  => Monoid m
  => (a -> m)
  -> f a
  -> m
foldMapDefaultL f = foldl (\acc x -> acc <> f x) mempty

instance foldableArray :: Foldable Array where
  foldr = foldrArray
  foldl = foldlArray
  foldMap = foldMapDefaultR

foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b
foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b

instance foldableMaybe :: Foldable Maybe where
  foldr _ z Nothing  = z
  foldr f z (Just x) = x `f` z
  foldl _ z Nothing  = z
  foldl f z (Just x) = z `f` x
  foldMap f Nothing  = mempty
  foldMap f (Just x) = f x

instance foldableFirst :: Foldable First where
  foldr f z (First x) = foldr f z x
  foldl f z (First x) = foldl f z x
  foldMap f (First x) = foldMap f x

instance foldableLast :: Foldable Last where
  foldr f z (Last x) = foldr f z x
  foldl f z (Last x) = foldl f z x
  foldMap f (Last x) = foldMap f x

instance foldableAdditive :: Foldable Additive where
  foldr f z (Additive x) = x `f` z
  foldl f z (Additive x) = z `f` x
  foldMap f (Additive x) = f x

instance foldableDual :: Foldable Dual where
  foldr f z (Dual x) = x `f` z
  foldl f z (Dual x) = z `f` x
  foldMap f (Dual x) = f x

instance foldableDisj :: Foldable Disj where
  foldr f z (Disj x) = f x z
  foldl f z (Disj x) = f z x
  foldMap f (Disj x) = f x

instance foldableConj :: Foldable Conj where
  foldr f z (Conj x) = f x z
  foldl f z (Conj x) = f z x
  foldMap f (Conj x) = f x

instance foldableMultiplicative :: Foldable Multiplicative where
  foldr f z (Multiplicative x) = x `f` z
  foldl f z (Multiplicative x) = z `f` x
  foldMap f (Multiplicative x) = f x

-- | Fold a data structure, accumulating values in some `Monoid`.
fold :: forall f m. Foldable f => Monoid m => f m -> m
fold = foldMap id

-- | Similar to 'foldl', but the result is encapsulated in a monad.
-- |
-- | Note: this function is not generally stack-safe, e.g., for monads which
-- | build up thunks a la `Eff`.
foldM :: forall f m a b. Foldable f => Monad m => (a -> b -> m a) -> a -> f b -> m a
foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)

-- | Traverse a data structure, performing some effects encoded by an
-- | `Applicative` functor at each value, ignoring the final result.
-- |
-- | For example:
-- |
-- | ```purescript
-- | traverse_ print [1, 2, 3]
-- | ```
traverse_
  :: forall a b f m
   . Applicative m
  => Foldable f
  => (a -> m b)
  -> f a
  -> m Unit
traverse_ f = foldr ((*>) <<< f) (pure unit)

-- | A version of `traverse_` with its arguments flipped.
-- |
-- | This can be useful when running an action written using do notation
-- | for every element in a data structure:
-- |
-- | For example:
-- |
-- | ```purescript
-- | for_ [1, 2, 3] \n -> do
-- |   print n
-- |   trace "squared is"
-- |   print (n * n)
-- | ```
for_
  :: forall a b f m
   . Applicative m
  => Foldable f
  => f a
  -> (a -> m b)
  -> m Unit
for_ = flip traverse_

-- | Perform all of the effects in some data structure in the order
-- | given by the `Foldable` instance, ignoring the final result.
-- |
-- | For example:
-- |
-- | ```purescript
-- | sequence_ [ trace "Hello, ", trace " world!" ]
-- | ```
sequence_ :: forall a f m. Applicative m => Foldable f => f (m a) -> m Unit
sequence_ = traverse_ id

-- | Combines a collection of elements using the `Alt` operation.
oneOf :: forall f g a. Foldable f => Plus g => f (g a) -> g a
oneOf = foldr alt empty

-- | Folds a structure into some `Plus`.
oneOfMap :: forall f g a b. Foldable f => Plus g => (a -> g b) -> f a -> g b
oneOfMap f = foldr (alt <<< f) empty

-- | Fold a data structure, accumulating values in some `Monoid`,
-- | combining adjacent elements using the specified separator.
intercalate :: forall f m. Foldable f => Monoid m => m -> f m -> m
intercalate sep xs = (foldl go { init: true, acc: mempty } xs).acc
  where
  go { init: true } x = { init: false, acc: x }
  go { acc: acc }   x = { init: false, acc: acc <> sep <> x }

-- | `foldMap` but with each element surrounded by some fixed value.
-- |
-- | For example:
-- |
-- | ```purescript
-- | > surroundMap "*" show []
-- | = "*"
-- |
-- | > surroundMap "*" show [1]
-- | = "*1*"
-- |
-- | > surroundMap "*" show [1, 2]
-- | = "*1*2*"
-- |
-- | > surroundMap "*" show [1, 2, 3]
-- | = "*1*2*3*"
-- | ```
surroundMap :: forall f a m. Foldable f => Semigroup m => m -> (a -> m) -> f a -> m
surroundMap d t f = unwrap (foldMap joined f) d
  where joined a = Endo \m -> d <> t a <> m

-- | `fold` but with each element surrounded by some fixed value.
-- |
-- | For example:
-- |
-- | ```purescript
-- | > surround "*" []
-- | = "*"
-- |
-- | > surround "*" ["1"]
-- | = "*1*"
-- |
-- | > surround "*" ["1", "2"]
-- | = "*1*2*"
-- |
-- | > surround "*" ["1", "2", "3"]
-- | = "*1*2*3*"
-- | ```
surround :: forall f m. Foldable f => Semigroup m => m -> f m -> m
surround d = surroundMap d id

-- | The conjunction of all the values in a data structure. When specialized
-- | to `Boolean`, this function will test whether all of the values in a data
-- | structure are `true`.
and :: forall a f. Foldable f => HeytingAlgebra a => f a -> a
and = all id

-- | The disjunction of all the values in a data structure. When specialized
-- | to `Boolean`, this function will test whether any of the values in a data
-- | structure is `true`.
or :: forall a f. Foldable f => HeytingAlgebra a => f a -> a
or = any id

-- | `all f` is the same as `and <<< map f`; map a function over the structure,
-- | and then get the conjunction of the results.
all :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b
all  = alaF Conj foldMap

-- | `any f` is the same as `or <<< map f`; map a function over the structure,
-- | and then get the disjunction of the results.
any :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b
any = alaF Disj foldMap

-- | Find the sum of the numeric values in a data structure.
sum :: forall a f. Foldable f => Semiring a => f a -> a
sum = foldl (+) zero

-- | Find the product of the numeric values in a data structure.
product :: forall a f. Foldable f => Semiring a => f a -> a
product = foldl (*) one

-- | Test whether a value is an element of a data structure.
elem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean
elem = any <<< (==)

-- | Test whether a value is not an element of a data structure.
notElem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean
notElem x = not <<< elem x

-- | Try to get nth element from the left in a data structure
indexl :: forall a f. Foldable f => Int -> f a -> Maybe a
indexl idx = _.elem <<< foldl go { elem: Nothing, pos: 0 }
  where
  go cursor a =
    case cursor.elem of
      Just _ -> cursor
      _ ->
        if cursor.pos == idx
          then { elem: Just a, pos: cursor.pos }
          else { pos: cursor.pos + 1, elem: cursor.elem }

-- | Try to get nth element from the right in a data structure
indexr :: forall a f. Foldable f => Int -> f a -> Maybe a
indexr idx = _.elem <<< foldr go { elem: Nothing, pos: 0 }
  where
  go a cursor =
    case cursor.elem of
      Just _ -> cursor
      _ ->
        if cursor.pos == idx
          then { elem: Just a, pos: cursor.pos }
          else { pos: cursor.pos + 1, elem: cursor.elem }

-- | Try to find an element in a data structure which satisfies a predicate.
find :: forall a f. Foldable f => (a -> Boolean) -> f a -> Maybe a
find p = foldl go Nothing
  where
  go Nothing x | p x = Just x
  go r _ = r

-- | Try to find an element in a data structure which satisfies a predicate mapping.
findMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b
findMap p = foldl go Nothing
  where
  go Nothing x = p x
  go r _ = r

-- | Find the largest element of a structure, according to its `Ord` instance.
maximum :: forall a f. Ord a => Foldable f => f a -> Maybe a
maximum = maximumBy compare

-- | Find the largest element of a structure, according to a given comparison
-- | function. The comparison function should represent a total ordering (see
-- | the `Ord` type class laws); if it does not, the behaviour is undefined.
maximumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a
maximumBy cmp = foldl max' Nothing
  where
  max' Nothing x  = Just x
  max' (Just x) y = Just (if cmp x y == GT then x else y)

-- | Find the smallest element of a structure, according to its `Ord` instance.
minimum :: forall a f. Ord a => Foldable f => f a -> Maybe a
minimum = minimumBy compare

-- | Find the smallest element of a structure, according to a given comparison
-- | function. The comparison function should represent a total ordering (see
-- | the `Ord` type class laws); if it does not, the behaviour is undefined.
minimumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a
minimumBy cmp = foldl min' Nothing
  where
  min' Nothing x  = Just x
  min' (Just x) y = Just (if cmp x y == LT then x else y)

-- | Test whether the structure is empty.
-- | Optimized for structures that are similar to cons-lists, because there
-- | is no general way to do better.
null :: forall a f. Foldable f => f a -> Boolean
null = foldr (\_ _ -> false) true

-- | Returns the size/length of a finite structure.
-- | Optimized for structures that are similar to cons-lists, because there
-- | is no general way to do better.
length :: forall a b f. Foldable f => Semiring b => f a -> b
length = foldl (\c _ -> add one c) zero

module Data.Foldable
  ( class Foldable, foldr, foldl, foldMap
  , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR
  , fold
  , foldM
  , traverse_
  , for_
  , sequence_
  , oneOf
  , oneOfMap
  , intercalate
  , surroundMap
  , surround
  , and
  , or
  , all
  , any
  , sum
  , product
  , elem
  , notElem
  , indexl
  , indexr
  , find
  , findMap
  , maximum
  , maximumBy
  , minimum
  , minimumBy
  , null
  , length
  ) where

import Prelude

import Control.Plus (class Plus, alt, empty)

import Data.Maybe (Maybe(..))
import Data.Maybe.First (First(..))
import Data.Maybe.Last (Last(..))
import Data.Monoid (class Monoid, mempty)
import Data.Monoid.Additive (Additive(..))
import Data.Monoid.Conj (Conj(..))
import Data.Monoid.Disj (Disj(..))
import Data.Monoid.Dual (Dual(..))
import Data.Monoid.Endo (Endo(..))
import Data.Monoid.Multiplicative (Multiplicative(..))
import Data.Newtype (alaF, unwrap)

-- | `Foldable` represents data structures which can be _folded_.
-- |
-- | - `foldr` folds a structure from the right
-- | - `foldl` folds a structure from the left
-- | - `foldMap` folds a structure by accumulating values in a `Monoid`
-- |
-- | Default implementations are provided by the following functions:
-- |
-- | - `foldrDefault`
-- | - `foldlDefault`
-- | - `foldMapDefaultR`
-- | - `foldMapDefaultL`
-- |
-- | Note: some combinations of the default implementations are unsafe to
-- | use together - causing a non-terminating mutually recursive cycle.
-- | These combinations are documented per function.
class Foldable f where
  foldr :: forall a b. (a -> b -> b) -> b -> f a -> b
  foldl :: forall a b. (b -> a -> b) -> b -> f a -> b
  foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m

-- | A default implementation of `foldr` using `foldMap`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldMapDefaultR`.
foldrDefault
  :: forall f a b
   . Foldable f
  => (a -> b -> b)
  -> b
  -> f a
  -> b
foldrDefault c u xs = unwrap (foldMap (Endo <<< c) xs) u

-- | A default implementation of `foldl` using `foldMap`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldMapDefaultL`.
foldlDefault
  :: forall f a b
   . Foldable f
  => (b -> a -> b)
  -> b
  -> f a
  -> b
foldlDefault c u xs = unwrap (unwrap (foldMap (Dual <<< Endo <<< flip c) xs)) u

-- | A default implementation of `foldMap` using `foldr`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldrDefault`.
foldMapDefaultR
  :: forall f a m
   . Foldable f
  => Monoid m
  => (a -> m)
  -> f a
  -> m
foldMapDefaultR f = foldr (\x acc -> f x <> acc) mempty

-- | A default implementation of `foldMap` using `foldl`.
-- |
-- | Note: when defining a `Foldable` instance, this function is unsafe to use
-- | in combination with `foldlDefault`.
foldMapDefaultL
  :: forall f a m
   . Foldable f
  => Monoid m
  => (a -> m)
  -> f a
  -> m
foldMapDefaultL f = foldl (\acc x -> acc <> f x) mempty

instance foldableArray :: Foldable Array where
  foldr = foldrArray
  foldl = foldlArray
  foldMap = foldMapDefaultR

foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b
foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b

instance foldableMaybe :: Foldable Maybe where
  foldr _ z Nothing  = z
  foldr f z (Just x) = x `f` z
  foldl _ z Nothing  = z
  foldl f z (Just x) = z `f` x
  foldMap f Nothing  = mempty
  foldMap f (Just x) = f x

instance foldableFirst :: Foldable First where
  foldr f z (First x) = foldr f z x
  foldl f z (First x) = foldl f z x
  foldMap f (First x) = foldMap f x

instance foldableLast :: Foldable Last where
  foldr f z (Last x) = foldr f z x
  foldl f z (Last x) = foldl f z x
  foldMap f (Last x) = foldMap f x

instance foldableAdditive :: Foldable Additive where
  foldr f z (Additive x) = x `f` z
  foldl f z (Additive x) = z `f` x
  foldMap f (Additive x) = f x

instance foldableDual :: Foldable Dual where
  foldr f z (Dual x) = x `f` z
  foldl f z (Dual x) = z `f` x
  foldMap f (Dual x) = f x

instance foldableDisj :: Foldable Disj where
  foldr f z (Disj x) = f x z
  foldl f z (Disj x) = f z x
  foldMap f (Disj x) = f x

instance foldableConj :: Foldable Conj where
  foldr f z (Conj x) = f x z
  foldl f z (Conj x) = f z x
  foldMap f (Conj x) = f x

instance foldableMultiplicative :: Foldable Multiplicative where
  foldr f z (Multiplicative x) = x `f` z
  foldl f z (Multiplicative x) = z `f` x
  foldMap f (Multiplicative x) = f x

-- | Fold a data structure, accumulating values in some `Monoid`.
fold :: forall f m. Foldable f => Monoid m => f m -> m
fold = foldMap id

-- | Similar to 'foldl', but the result is encapsulated in a monad.
-- |
-- | Note: this function is not generally stack-safe, e.g., for monads which
-- | build up thunks a la `Eff`.
foldM :: forall f m a b. Foldable f => Monad m => (a -> b -> m a) -> a -> f b -> m a
foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)

-- | Traverse a data structure, performing some effects encoded by an
-- | `Applicative` functor at each value, ignoring the final result.
-- |
-- | For example:
-- |
-- | ```purescript
-- | traverse_ print [1, 2, 3]
-- | ```
traverse_
  :: forall a b f m
   . Applicative m
  => Foldable f
  => (a -> m b)
  -> f a
  -> m Unit
traverse_ f = foldr ((*>) <<< f) (pure unit)

-- | A version of `traverse_` with its arguments flipped.
-- |
-- | This can be useful when running an action written using do notation
-- | for every element in a data structure:
-- |
-- | For example:
-- |
-- | ```purescript
-- | for_ [1, 2, 3] \n -> do
-- |   print n
-- |   trace "squared is"
-- |   print (n * n)
-- | ```
for_
  :: forall a b f m
   . Applicative m
  => Foldable f
  => f a
  -> (a -> m b)
  -> m Unit
for_ = flip traverse_

-- | Perform all of the effects in some data structure in the order
-- | given by the `Foldable` instance, ignoring the final result.
-- |
-- | For example:
-- |
-- | ```purescript
-- | sequence_ [ trace "Hello, ", trace " world!" ]
-- | ```
sequence_ :: forall a f m. Applicative m => Foldable f => f (m a) -> m Unit
sequence_ = traverse_ id

-- | Combines a collection of elements using the `Alt` operation.
oneOf :: forall f g a. Foldable f => Plus g => f (g a) -> g a
oneOf = foldr alt empty

-- | Folds a structure into some `Plus`.
oneOfMap :: forall f g a b. Foldable f => Plus g => (a -> g b) -> f a -> g b
oneOfMap f = foldr (alt <<< f) empty

-- | Fold a data structure, accumulating values in some `Monoid`,
-- | combining adjacent elements using the specified separator.
intercalate :: forall f m. Foldable f => Monoid m => m -> f m -> m
intercalate sep xs = (foldl go { init: true, acc: mempty } xs).acc
  where
  go { init: true } x = { init: false, acc: x }
  go { acc: acc }   x = { init: false, acc: acc <> sep <> x }

-- | `foldMap` but with each element surrounded by some fixed value.
-- |
-- | For example:
-- |
-- | ```purescript
-- | > surroundMap "*" show []
-- | = "*"
-- |
-- | > surroundMap "*" show [1]
-- | = "*1*"
-- |
-- | > surroundMap "*" show [1, 2]
-- | = "*1*2*"
-- |
-- | > surroundMap "*" show [1, 2, 3]
-- | = "*1*2*3*"
-- | ```
surroundMap :: forall f a m. Foldable f => Semigroup m => m -> (a -> m) -> f a -> m
surroundMap d t f = unwrap (foldMap joined f) d
  where joined a = Endo \m -> d <> t a <> m

-- | `fold` but with each element surrounded by some fixed value.
-- |
-- | For example:
-- |
-- | ```purescript
-- | > surround "*" []
-- | = "*"
-- |
-- | > surround "*" ["1"]
-- | = "*1*"
-- |
-- | > surround "*" ["1", "2"]
-- | = "*1*2*"
-- |
-- | > surround "*" ["1", "2", "3"]
-- | = "*1*2*3*"
-- | ```
surround :: forall f m. Foldable f => Semigroup m => m -> f m -> m
surround d = surroundMap d id

-- | The conjunction of all the values in a data structure. When specialized
-- | to `Boolean`, this function will test whether all of the values in a data
-- | structure are `true`.
and :: forall a f. Foldable f => HeytingAlgebra a => f a -> a
and = all id

-- | The disjunction of all the values in a data structure. When specialized
-- | to `Boolean`, this function will test whether any of the values in a data
-- | structure is `true`.
or :: forall a f. Foldable f => HeytingAlgebra a => f a -> a
or = any id

-- | `all f` is the same as `and <<< map f`; map a function over the structure,
-- | and then get the conjunction of the results.
all :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b
all  = alaF Conj foldMap

-- | `any f` is the same as `or <<< map f`; map a function over the structure,
-- | and then get the disjunction of the results.
any :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b
any = alaF Disj foldMap

-- | Find the sum of the numeric values in a data structure.
sum :: forall a f. Foldable f => Semiring a => f a -> a
sum = foldl (+) zero

-- | Find the product of the numeric values in a data structure.
product :: forall a f. Foldable f => Semiring a => f a -> a
product = foldl (*) one

-- | Test whether a value is an element of a data structure.
elem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean
elem = any <<< (==)

-- | Test whether a value is not an element of a data structure.
notElem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean
notElem x = not <<< elem x

-- | Try to get nth element from the left in a data structure
indexl :: forall a f. Foldable f => Int -> f a -> Maybe a
indexl idx = _.elem <<< foldl go { elem: Nothing, pos: 0 }
  where
  go cursor elem =
    case cursor.elem of
      Just _ -> cursor
      _ ->
        if cursor.pos == idx
          then { elem: Just elem, pos: cursor.pos }
          else { pos: cursor.pos + 1, elem: cursor.elem }

-- | Try to get nth element from the right in a data structure
indexr :: forall a f. Foldable f => Int -> f a -> Maybe a
indexr idx = _.elem <<< foldr go { elem: Nothing, pos: 0 }
  where
  go elem cursor =
    case cursor.elem of
      Just _ -> cursor
      _ ->
        if cursor.pos == idx
          then { elem: Just elem, pos: cursor.pos }
          else { pos: cursor.pos + 1, elem: cursor.elem }

-- | Try to find an element in a data structure which satisfies a predicate.
find :: forall a f. Foldable f => (a -> Boolean) -> f a -> Maybe a
find p = foldl go Nothing
  where
  go Nothing x | p x = Just x
  go r _ = r

-- | Try to find an element in a data structure which satisfies a predicate mapping.
findMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b
findMap p = foldl go Nothing
  where
  go Nothing x = p x
  go r _ = r

-- | Find the largest element of a structure, according to its `Ord` instance.
maximum :: forall a f. Ord a => Foldable f => f a -> Maybe a
maximum = maximumBy compare

-- | Find the largest element of a structure, according to a given comparison
-- | function. The comparison function should represent a total ordering (see
-- | the `Ord` type class laws); if it does not, the behaviour is undefined.
maximumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a
maximumBy cmp = foldl max' Nothing
  where
  max' Nothing x  = Just x
  max' (Just x) y = Just (if cmp x y == GT then x else y)

-- | Find the smallest element of a structure, according to its `Ord` instance.
minimum :: forall a f. Ord a => Foldable f => f a -> Maybe a
minimum = minimumBy compare

-- | Find the smallest element of a structure, according to a given comparison
-- | function. The comparison function should represent a total ordering (see
-- | the `Ord` type class laws); if it does not, the behaviour is undefined.
minimumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a
minimumBy cmp = foldl min' Nothing
  where
  min' Nothing x  = Just x
  min' (Just x) y = Just (if cmp x y == LT then x else y)

-- | Test whether the structure is empty.
-- | Optimized for structures that are similar to cons-lists, because there
-- | is no general way to do better.
null :: forall a f. Foldable f => f a -> Boolean
null = foldr (\_ _ -> false) true

-- | Returns the size/length of a finite structure.
-- | Optimized for structures that are similar to cons-lists, because there
-- | is no general way to do better.
length :: forall a b f. Foldable f => Semiring b => f a -> b
length = foldl (\c _ -> add one c) zero


Rewriting tests using purescript-test-unit

module Test.Main where

import Prelude
import Main

import Test.Unit (suite, test, timeout)
import Test.Unit.Main (runTest)
import Test.Unit.Assert as Assert

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Exception (EXCEPTION, Error, catchException, throwException)

--main :: forall e. Eff (assert::ASSERT, err::EXCEPTION, console :: CONSOLE | e) Unit
main = runTest do
  suite "convertToWsUrl" do
    test "Port+Path+Query" do
      url1 <- liftEff $ convertToWsUrl "http://localhost:12000/static/index.html?q=123"
      Assert.equal url1 "ws://localhost:12000/ws/stats"
    test "Port+EmptyPath" do
      url2 <- liftEff $ convertToWsUrl "http://test.org:80/"
      Assert.equal url2 "ws://test.org:80/ws/stats"
    test "Port" do
      url3 <- liftEff $ convertToWsUrl "http://test.org:80"
      Assert.equal url3 "ws://test.org:80/ws/stats"

module Test.Main where

import Prelude
import Main
import Test.Assert
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Exception (EXCEPTION, Error, catchException, throwException)

main :: forall e. Eff (assert::ASSERT, err::EXCEPTION, console :: CONSOLE | e) Unit
main = do
  convertToWsUrlTests

convertToWsUrlTests :: forall e. Eff (assert::ASSERT, console :: CONSOLE, err::EXCEPTION | e) Unit
convertToWsUrlTests = do
  url1 <- convertToWsUrl "http://localhost:12000/static/index.html?q=123"
  assert (url1 == "ws://localhost:12000/ws/stats")
  url2 <- convertToWsUrl "http://test.org:80/"
  assert (url2 == "ws://test.org:80/ws/stats")
  url3 <- convertToWsUrl "http://test.org:80"
  assert (url3 == "ws://test.org:80/ws/stats")
  --(catchException ((\_ -> log "Exception caught as expected"):: Error -> Eff (console :: CONSOLE | e) Unit) ((const unit) <$> (convertToWsUrl "./test.org:80")))