Don't mess up active drill down when evaling cards

{-
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.Workspace.Card.Next.Component
 ( nextCardComponent
 , module SlamData.Workspace.Card.Next.Component.State
 , module SlamData.Workspace.Card.Next.Component.Query
 ) where

import SlamData.Prelude

import Data.Foldable as F
import Data.Lens ((.~))
import Data.String as Str

import Halogen as H
import Halogen.HTML.Events.Indexed as HE
import Halogen.HTML.Indexed as HH
import Halogen.HTML.Properties.Indexed as HP
import Halogen.HTML.Properties.Indexed.ARIA as ARIA
import Halogen.Themes.Bootstrap3 as B
import Halogen.Component.Utils as HU

import SlamData.Monad (Slam)
import SlamData.Render.Common (glyph)
import SlamData.Guide as Guide
import SlamData.Workspace.Card.CardType as CT
import SlamData.Workspace.Card.Component as CC
import SlamData.Workspace.Card.Model as Card
import SlamData.Workspace.Card.Next.NextAction as NA
import SlamData.Workspace.Card.Next.Component.Query (QueryP, Query(..), _AddCardType, _PresentReason)
import SlamData.Workspace.Card.Next.Component.State (State)
import SlamData.Workspace.Card.Next.Component.State as State
import SlamData.Workspace.Card.Port as Port
import SlamData.Workspace.Card.InsertableCardType as ICT

import Utils.LocalStorage as LocalStorage

type NextHTML = H.ComponentHTML QueryP
type NextDSL = H.ComponentDSL State QueryP Slam

nextCardComponent ∷ CC.CardComponent
nextCardComponent = CC.makeCardComponent
  { cardType: CT.NextAction
  , component:
      H.component
        { render
        , eval
        }
  , initialState: State.initialState
  , _State: CC._NextState
  , _Query: CC.makeQueryPrism CC._NextQuery
  }

render ∷ State → NextHTML
render state =
  HH.div_
    $ (guard (not state.presentAddCardGuide) $>
      HH.form_
        [ HH.div_
            [ HH.input
                [ HP.value state.filterString
                , HE.onValueInput (HE.input (\s → right ∘ UpdateFilter s))
                , ARIA.label "Filter next actions"
                , HP.placeholder "Filter actions"
                ]
            , HH.button
                [ HP.buttonType HP.ButtonButton
                , HE.onClick (HE.input_ (right ∘ UpdateFilter ""))
                ]
                [ glyph B.glyphiconRemove ]
            ]
        ])
    ⊕ (guard state.presentAddCardGuide $>
        Guide.render
          Guide.DownArrow
          (HH.className "sd-add-card-guide")
          (right ∘ DismissAddCardGuide)
          (addCardGuideText state.input))
    ⊕ [ HH.ul_ $ map nextButton state.actions ]
  where

  filterString ∷ String
  filterString = Str.toLower state.filterString

  cardTitle ∷ NA.NextAction → String
  cardTitle (NA.Insert cty) = "Insert a " ⊕ CT.cardName cty ⊕ " card"
  cardTitle (NA.FindOutHowToInsert cty) = "Find out how to insert a " ⊕ CT.cardName cty ⊕ " card"
  cardTitle (NA.Drill name _ _) = "Select " ⊕ name ⊕ " card category"
  cardTitle (NA.GoBack) = "Go back"

  nextButton ∷ NA.NextAction → NextHTML
  nextButton action =
    HH.li_
      [ HH.button attrs
          [ NA.actionGlyph action
          , HH.p_ [ HH.text $ NA.actionLabel action ]
          ]
      ]
    where
    enabled ∷ Boolean
    enabled = case action of
      NA.GoBack → true
      _ → F.any (Str.contains filterString ∘ Str.toLower) $ NA.searchFilters action

    attrs =
      [ HP.title $ cardTitle action
      , HP.disabled $ not enabled
      , ARIA.label $ cardTitle action
      , HP.classes classes
      , HE.onClick (HE.input_ $ right ∘ Selected action)
      ]

    classes ∷ Array HH.ClassName
    classes = case action of
      NA.FindOutHowToInsert _ →
        nonInsertableClassNames
      NA.Drill _ _ actions | not (F.any NA.isInsert actions) →
        nonInsertableClassNames
      _ →
        insertableClassNames

    insertableClassNames =
      [ HH.className "sd-button" ]

    nonInsertableClassNames =
        [ HH.className "sd-button", HH.className "sd-button-warning" ]

  addCardGuideTextEmptyDeck = "To get this deck started press one of these buttons to add a card."
  addCardGuideTextNonEmptyDeck = "To do more with this deck press one of these buttons to add a card."
  addCardGuideText = maybe addCardGuideTextEmptyDeck (const addCardGuideTextNonEmptyDeck)

eval ∷ QueryP ~> NextDSL
eval = coproduct cardEval nextEval

cardEval ∷ CC.CardEvalQuery ~> NextDSL
cardEval = case _ of
  CC.EvalCard value output next →
    (H.modify $ (State._input .~ value.input) ∘ updateActions value.input)
       $> next
  CC.Activate next →
    (H.modify ∘ updateActions =<< H.gets _.input) $> next
  CC.Deactivate next →
    pure next
  CC.Save k →
    pure $ k Card.NextAction
  CC.Load _ next →
    pure next
  CC.SetDimensions _ next →
    pure next
  CC.ModelUpdated _ next →
    pure next
  CC.ZoomIn next →
    pure next

updateActions ∷ Maybe Port.Port → State → State
updateActions input state =
  case activeDrill of
    Nothing →
      state
        { actions = newActions }
    Just drill →
      state
        { previousActions = newActions
        , actions = fromMaybe [] $ pluckDrillActions =<< newActiveDrill
        }
  where
  newActions = NA.fromMaybePort input

  activeDrill =
    F.find
      (maybe false (eq state.actions) ∘ pluckDrillActions)
      state.previousActions

  newActiveDrill =
    F.find (maybe false eqNameOfActiveDrill ∘ pluckDrillName) newActions

  eqNameOfActiveDrill name =
    maybe false (eq name) (pluckDrillName =<< activeDrill)

  pluckDrillActions = case _ of
    NA.Drill _ _ xs → Just xs
    _ → Nothing

  pluckDrillName = case _ of
    NA.Drill x _ _ → Just x
    _ → Nothing

takesInput ∷ Maybe Port.Port → CT.CardType → Boolean
takesInput input =
  maybe false (ICT.takesInput $ ICT.fromMaybePort input) ∘ ICT.fromCardType

possibleToGetTo ∷ Maybe Port.Port → CT.CardType → Boolean
possibleToGetTo input =
  maybe false (ICT.possibleToGetTo $ ICT.fromMaybePort input) ∘ ICT.fromCardType

dismissedAddCardGuideKey ∷ String
dismissedAddCardGuideKey = "dismissedAddCardGuide"

getDismissedAddCardGuideBefore ∷ NextDSL Boolean
getDismissedAddCardGuideBefore =
  H.liftH
    $ either (const $ false) id
    <$> LocalStorage.getLocalStorage dismissedAddCardGuideKey

storeDismissedAddCardGuide ∷ NextDSL Unit
storeDismissedAddCardGuide =
  H.liftH $ LocalStorage.setLocalStorage dismissedAddCardGuideKey true

dismissAddCardGuide ∷ NextDSL Unit
dismissAddCardGuide =
  H.modify (State._presentAddCardGuide .~ false)
    *> storeDismissedAddCardGuide

nextEval ∷ Query ~> NextDSL
nextEval (AddCard _ next) = dismissAddCardGuide $> next
nextEval (PresentReason io card next) = pure next
nextEval (UpdateFilter str next) =
  H.modify (State._filterString .~ str) $> next
nextEval (DismissAddCardGuide next) = dismissAddCardGuide $> next
nextEval (PresentAddCardGuide next) =
  (H.modify
     ∘ (State._presentAddCardGuide .~ _)
     ∘ not =<< getDismissedAddCardGuideBefore)
     $> next
nextEval (Selected action next) = do
  st ← H.get
  case action of
    NA.Insert cardType →
      HU.raise $ right $ H.action $ AddCard cardType
    NA.FindOutHowToInsert cardType →
      HU.raise $ right $ H.action $ PresentReason st.input cardType
    NA.Drill _ _ actions →
      H.modify $ (State._actions .~ actions) ∘ (State._previousActions .~ st.actions)
    NA.GoBack →
      H.modify
        $ (State._actions .~ st.previousActions)
        ∘ (State._previousActions .~ [ ])
  pure next

{-
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.Workspace.Card.Next.Component
 ( nextCardComponent
 , module SlamData.Workspace.Card.Next.Component.State
 , module SlamData.Workspace.Card.Next.Component.Query
 ) where

import SlamData.Prelude

import Data.Foldable as F
import Data.Lens ((.~))
import Data.String as Str

import Halogen as H
import Halogen.HTML.Events.Indexed as HE
import Halogen.HTML.Indexed as HH
import Halogen.HTML.Properties.Indexed as HP
import Halogen.HTML.Properties.Indexed.ARIA as ARIA
import Halogen.Themes.Bootstrap3 as B
import Halogen.Component.Utils as HU

import SlamData.Monad (Slam)
import SlamData.Render.Common (glyph)
import SlamData.Guide as Guide
import SlamData.Workspace.Card.CardType as CT
import SlamData.Workspace.Card.Component as CC
import SlamData.Workspace.Card.Model as Card
import SlamData.Workspace.Card.Next.NextAction as NA
import SlamData.Workspace.Card.Next.Component.Query (QueryP, Query(..), _AddCardType, _PresentReason)
import SlamData.Workspace.Card.Next.Component.State (State)
import SlamData.Workspace.Card.Next.Component.State as State
import SlamData.Workspace.Card.Port as Port
import SlamData.Workspace.Card.InsertableCardType as ICT

import Utils.LocalStorage as LocalStorage

type NextHTML = H.ComponentHTML QueryP
type NextDSL = H.ComponentDSL State QueryP Slam

nextCardComponent ∷ CC.CardComponent
nextCardComponent = CC.makeCardComponent
  { cardType: CT.NextAction
  , component:
      H.component
        { render
        , eval
        }
  , initialState: State.initialState
  , _State: CC._NextState
  , _Query: CC.makeQueryPrism CC._NextQuery
  }

render ∷ State → NextHTML
render state =
  HH.div_
    $ (guard (not state.presentAddCardGuide) $>
      HH.form_
        [ HH.div_
            [ HH.input
                [ HP.value state.filterString
                , HE.onValueInput (HE.input (\s → right ∘ UpdateFilter s))
                , ARIA.label "Filter next actions"
                , HP.placeholder "Filter actions"
                ]
            , HH.button
                [ HP.buttonType HP.ButtonButton
                , HE.onClick (HE.input_ (right ∘ UpdateFilter ""))
                ]
                [ glyph B.glyphiconRemove ]
            ]
        ])
    ⊕ (guard state.presentAddCardGuide $>
        Guide.render
          Guide.DownArrow
          (HH.className "sd-add-card-guide")
          (right ∘ DismissAddCardGuide)
          (addCardGuideText state.input))
    ⊕ [ HH.ul_ $ map nextButton state.actions ]
  where

  filterString ∷ String
  filterString = Str.toLower state.filterString

  cardTitle ∷ NA.NextAction → String
  cardTitle (NA.Insert cty) = "Insert a " ⊕ CT.cardName cty ⊕ " card"
  cardTitle (NA.FindOutHowToInsert cty) = "Find out how to insert a " ⊕ CT.cardName cty ⊕ " card"
  cardTitle (NA.Drill name _ _) = "Select " ⊕ name ⊕ " card category"
  cardTitle (NA.GoBack) = "Go back"

  nextButton ∷ NA.NextAction → NextHTML
  nextButton action =
    HH.li_
      [ HH.button attrs
          [ NA.actionGlyph action
          , HH.p_ [ HH.text $ NA.actionLabel action ]
          ]
      ]
    where
    enabled ∷ Boolean
    enabled = case action of
      NA.GoBack → true
      _ → F.any (Str.contains filterString ∘ Str.toLower) $ NA.searchFilters action

    attrs =
      [ HP.title $ cardTitle action
      , HP.disabled $ not enabled
      , ARIA.label $ cardTitle action
      , HP.classes classes
      , HE.onClick (HE.input_ $ right ∘ Selected action)
      ]

    classes ∷ Array HH.ClassName
    classes = case action of
      NA.FindOutHowToInsert _ →
        nonInsertableClassNames
      NA.Drill _ _ actions | not (F.any NA.isInsert actions) →
        nonInsertableClassNames
      _ →
        insertableClassNames

    insertableClassNames =
      [ HH.className "sd-button" ]

    nonInsertableClassNames =
        [ HH.className "sd-button", HH.className "sd-button-warning" ]

  addCardGuideTextEmptyDeck = "To get this deck started press one of these buttons to add a card."
  addCardGuideTextNonEmptyDeck = "To do more with this deck press one of these buttons to add a card."
  addCardGuideText = maybe addCardGuideTextEmptyDeck (const addCardGuideTextNonEmptyDeck)

eval ∷ QueryP ~> NextDSL
eval = coproduct cardEval nextEval

cardEval ∷ CC.CardEvalQuery ~> NextDSL
cardEval = case _ of
  CC.EvalCard value output next →
    (H.modify
       $ (State._input .~ value.input)
       ∘ (State._actions .~ NA.fromMaybePort value.input))
       $> next
  CC.Activate next →
    H.modify (\st → st { actions = NA.fromMaybePort st.input }) $> next
  CC.Deactivate next →
    pure next
  CC.Save k →
    pure $ k Card.NextAction
  CC.Load _ next →
    pure next
  CC.SetDimensions _ next →
    pure next
  CC.ModelUpdated _ next →
    pure next
  CC.ZoomIn next →
    pure next

takesInput ∷ Maybe Port.Port → CT.CardType → Boolean
takesInput input =
  maybe false (ICT.takesInput $ ICT.fromMaybePort input) ∘ ICT.fromCardType

possibleToGetTo ∷ Maybe Port.Port → CT.CardType → Boolean
possibleToGetTo input =
  maybe false (ICT.possibleToGetTo $ ICT.fromMaybePort input) ∘ ICT.fromCardType

dismissedAddCardGuideKey ∷ String
dismissedAddCardGuideKey = "dismissedAddCardGuide"

getDismissedAddCardGuideBefore ∷ NextDSL Boolean
getDismissedAddCardGuideBefore =
  H.liftH
    $ either (const $ false) id
    <$> LocalStorage.getLocalStorage dismissedAddCardGuideKey

storeDismissedAddCardGuide ∷ NextDSL Unit
storeDismissedAddCardGuide =
  H.liftH $ LocalStorage.setLocalStorage dismissedAddCardGuideKey true

dismissAddCardGuide ∷ NextDSL Unit
dismissAddCardGuide =
  H.modify (State._presentAddCardGuide .~ false)
    *> storeDismissedAddCardGuide

nextEval ∷ Query ~> NextDSL
nextEval (AddCard _ next) = dismissAddCardGuide $> next
nextEval (PresentReason io card next) = pure next
nextEval (UpdateFilter str next) =
  H.modify (State._filterString .~ str) $> next
nextEval (DismissAddCardGuide next) = dismissAddCardGuide $> next
nextEval (PresentAddCardGuide next) =
  (H.modify
     ∘ (State._presentAddCardGuide .~ _)
     ∘ not =<< getDismissedAddCardGuideBefore)
     $> next
nextEval (Selected action next) = do
  st ← H.get
  case action of
    NA.Insert cardType →
      HU.raise $ right $ H.action $ AddCard cardType
    NA.FindOutHowToInsert cardType →
      HU.raise $ right $ H.action $ PresentReason st.input cardType
    NA.Drill _ _ actions →
      H.modify $ (State._actions .~ actions) ∘ (State._previousActions .~ st.actions)
    NA.GoBack →
      H.modify
        $ (State._actions .~ st.previousActions)
        ∘ (State._previousActions .~ [ ])
  pure next


Shadowed name warning

Shadowed name warning

module Test.Main where

import Prelude

import Control.Alt ((<|>))
import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, peekVar, killVar)
import Control.Monad.Aff.Console (CONSOLE, log)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (log) as Eff
import Control.Monad.Eff.Exception (EXCEPTION, throwException, error, message, try)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Rec.Class (Step(..), tailRecM)
import Control.Parallel (parallel, sequential)
import Data.Either (either, fromLeft, fromRight)
import Data.Unfoldable (replicate)
import Partial.Unsafe (unsafePartial)

type Test a = forall e. Aff (console :: CONSOLE | e) a
type TestAVar a = forall e. Aff (console :: CONSOLE, avar :: AVAR | e) a

replicateArray :: forall a. Int -> a -> Array a
replicateArray = replicate

test_sequencing :: Int -> Test Unit
test_sequencing 0 = log "Done"
test_sequencing n = do
  later' 100 (log (show (n / 10) <> " seconds left"))
  test_sequencing (n - 1)

foreign import synchronousUnexpectedThrowError :: forall e. Eff e Unit

test_makeAff :: Test Unit
test_makeAff = unsafePartial do
  s <- attempt $ makeAff \reject resolve -> resolve "ok"
  log $ "makeAff success is " <> fromRight s

  asyncF <- attempt $ makeAff \reject resolve -> reject (error "ok")
  log $ "makeAff asynchronous failure is " <> message (fromLeft asyncF)

  asyncF' <- attempt $ makeAff \reject resolve -> synchronousUnexpectedThrowError
  log $ "makeAff synchronous failure is " <> message (fromLeft asyncF')

  log "Success: makeAff is ok"

test_pure :: Test Unit
test_pure = do
  pure unit
  pure unit
  pure unit
  log "Success: Got all the way past 4 pures"

test_attempt :: Test Unit
test_attempt = do
  e <- attempt (throwError (error "Oh noes!"))
  either (const $ log "Success: Exception caught") (const $ log "Failure: Exception NOT caught!!!") e

test_apathize :: Test Unit
test_apathize = do
  apathize $ throwError (error "Oh noes!")
  log "Success: Exceptions don't stop the apathetic"

test_putTakeVar :: TestAVar Unit
test_putTakeVar = do
  v <- makeVar
  forkAff (later $ putVar v 1.0)
  a <- takeVar v
  log ("Success: Value " <> show a)

test_peekVar :: TestAVar Unit
test_peekVar = do
  v <- makeVar
  forkAff (later $ putVar v 1.0)
  a1 <- peekVar v
  a2 <- takeVar v
  when (a1 /= a2) do
    throwError (error "Something horrible went wrong - peeked var is not equal to taken var")
  log ("Success: Peeked value not consumed")

  w <- makeVar
  putVar w true
  b <- peekVar w
  when (not b) do
    throwError (error "Something horrible went wrong - peeked var is not true")
  log ("Success: Peeked value read from written var")

test_killFirstForked :: Test Unit
test_killFirstForked = do
  c <- forkAff (later' 100 $ pure "Failure: This should have been killed!")
  b <- c `cancel` (error "Just die")
  log (if b then "Success: Killed first forked" else "Failure: Couldn't kill first forked")

test_killVar :: TestAVar Unit
test_killVar = do
  v <- makeVar
  killVar v (error "DOA")
  e <- attempt $ takeVar v
  either (const $ log "Success: Killed queue dead") (const $ log "Failure: Oh noes, queue survived!") e

test_finally :: TestAVar Unit
test_finally = do
  v <- makeVar
  finally
    (putVar v 0)
    (putVar v 2)
  apathize $ finally
    (throwError (error "poof!") *> putVar v 666) -- this putVar should not get executed
    (putVar v 40)
  n1 <- takeVar v
  n2 <- takeVar v
  n3 <- takeVar v
  log $ if n1 + n2 + n3 == 42 then "Success: effects amount to 42."
                                else "Failure: Expected 42."

test_parRace :: TestAVar Unit
test_parRace = do
  s <- sequential (parallel (later' 100 $ pure "Success: Early bird got the worm") <|>
               parallel (later' 200 $ pure "Failure: Late bird got the worm"))
  log s

test_parError :: TestAVar Unit
test_parError = do
  e <- attempt $ sequential (parallel (throwError (error ("Oh noes!"))) *> pure unit)
  either (const $ log "Success: Exception propagated") (const $ log "Failure: Exception missing") e

test_parRaceKill1 :: TestAVar Unit
test_parRaceKill1 = do
  s <- sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
               parallel (later' 200 $ pure "Success: Early error was ignored in favor of late success"))
  log s

test_parRaceKill2 :: TestAVar Unit
test_parRaceKill2 = do
  e <- attempt $ sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
                         parallel (later' 200 $ throwError (error ("Oh noes!"))))
  either (const $ log "Success: Killing both kills it dead") (const $ log "Failure: It's alive!!!") e

test_semigroupCanceler :: Test Unit
test_semigroupCanceler =
  let
    c = Canceler (const (pure true)) <> Canceler (const (pure true))
  in do
    v <- cancel c (error "CANCEL")
    log (if v then "Success: Canceled semigroup composite canceler"
                     else "Failure: Could not cancel semigroup composite canceler")

test_cancelLater :: TestAVar Unit
test_cancelLater = do
  c <- forkAff $ (do pure "Binding"
                     _ <- later' 100 $ log ("Failure: Later was not canceled!")
                     pure "Binding")
  v <- cancel c (error "Cause")
  log (if v then "Success: Canceled later" else "Failure: Did not cancel later")

test_cancelLaunchLater :: forall e. Eff (console :: CONSOLE, err :: EXCEPTION | e) Unit
test_cancelLaunchLater = do
  c <- launchAff $ later' 100 $ log ("Failure: Later was not canceled!")
  void $ launchAff $ (do v <- cancel c (error "Cause")
                         log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))

test_cancelRunLater :: forall e. Eff (console :: CONSOLE | e) Unit
test_cancelRunLater = do
  c <- runAff (const (pure unit)) (const (pure unit)) $ later' 100 $ log ("Failure: Later was not canceled!")
  void $ try $ launchAff $ (do v <- cancel c (error "Cause")
                               log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))

test_cancelParallel :: TestAVar Unit
test_cancelParallel = do
  c  <- forkAff <<< sequential $ parallel (later' 100 $ log "Failure: #1 should not get through") <|>
                             parallel (later' 100 $ log "Failure: #2 should not get through")
  v  <- c `cancel` (error "Must cancel")
  log (if v then "Success: Canceling composite of two Parallel succeeded"
                   else "Failure: Canceling composite of two Parallel failed")

test_syncTailRecM :: TestAVar Unit
test_syncTailRecM = do
  v <- makeVar' false
  _ <- forkAff $ tailRecM go { n: 1000000, v }
  b <- takeVar v
  log (if b then "Success: Synchronous tailRecM resolved synchronously"
            else "Failure: Synchronous tailRecM resolved asynchronously")
  where
  go { n: 0, v } = do
    modifyVar (const true) v
    pure (Done 0)
  go { n, v } = pure (Loop { n: n - 1, v })

loopAndBounce :: forall eff. Int -> Aff (console :: CONSOLE | eff) Unit
loopAndBounce n = do
  res <- tailRecM go n
  log $ "Done: " <> show res
  where
  go 0 = pure (Done 0)
  go k | mod k 30000 == 0 = do
    later' 10 (pure unit)
    pure (Loop (k - 1))
  go k = pure (Loop (k - 1))

all :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
all n = do
  var <- makeVar' 0
  forkAll $ replicateArray n (modifyVar (_ + 1) var)
  count <- takeVar var
  log ("Forked " <> show count)

cancelAll :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
cancelAll n = do
  canceler <- forkAll $ replicateArray n (later' 100000 (log "oops"))
  canceled <- cancel canceler (error "bye")
  log ("Cancelled all: " <> show canceled)

delay :: forall eff. Int -> Aff eff Unit
delay n = later' n (pure unit)

main :: Eff (console :: CONSOLE, avar :: AVAR, err :: EXCEPTION) Unit
main = do
  Eff.log "Testing kill of later launched in separate Aff"
  test_cancelLaunchLater

  Eff.log "Testing kill of later run in separate Aff"
  test_cancelRunLater

  void $ runAff throwException (const (pure unit)) $ do
    log "Testing sequencing"
    test_sequencing 3

    log "Testing pure"
    test_pure

    log "Testing makeAff"
    test_makeAff

    log "Testing attempt"
    test_attempt

    log "Testing later"
    later $ log "Success: It happened later"

    log "Testing kill of later"
    test_cancelLater

    log "Testing kill of first forked"
    test_killFirstForked

    log "Testing apathize"
    test_apathize

    log "Testing semigroup canceler"
    test_semigroupCanceler

    log "Testing AVar - putVar, takeVar"
    test_putTakeVar

    log "Testing AVar - peekVar"
    test_peekVar

    log "Testing AVar killVar"
    test_killVar

    log "Testing finally"
    test_finally

    log "Test Parallel (*>)"
    test_parError

    log "Testing Parallel (<|>)"
    test_parRace

    log "Testing Parallel (<|>) - kill one"
    test_parRaceKill1

    log "Testing Parallel (<|>) - kill two"
    test_parRaceKill2

    log "Testing cancel of Parallel (<|>)"
    test_cancelParallel

    log "Testing synchronous tailRecM"
    test_syncTailRecM

    log "pre-delay"
    delay 1000
    log "post-delay"

    loopAndBounce 1000000

    all 100000

    cancelAll 100000

    log "Done testing"

module Test.Main where

import Prelude

import Control.Alt ((<|>))
import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, peekVar, killVar)
import Control.Monad.Aff.Console (CONSOLE, log)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (log) as Eff
import Control.Monad.Eff.Exception (EXCEPTION, throwException, error, message, try)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Rec.Class (Step(..), tailRecM)
import Control.Parallel (parallel, sequential)
import Data.Either (either, fromLeft, fromRight)
import Data.Unfoldable (replicate)
import Partial.Unsafe (unsafePartial)

type Test a = forall e. Aff (console :: CONSOLE | e) a
type TestAVar a = forall e. Aff (console :: CONSOLE, avar :: AVAR | e) a

replicateArray :: forall a. Int -> a -> Array a
replicateArray = replicate

test_sequencing :: Int -> Test Unit
test_sequencing 0 = log "Done"
test_sequencing n = do
  later' 100 (log (show (n / 10) <> " seconds left"))
  test_sequencing (n - 1)

foreign import synchronousUnexpectedThrowError :: forall e. Eff e Unit

test_makeAff :: Test Unit
test_makeAff = unsafePartial do
  s <- attempt $ makeAff \reject resolve -> resolve "ok"
  log $ "makeAff success is " <> fromRight s

  asyncF <- attempt $ makeAff \reject resolve -> reject (error "ok")
  log $ "makeAff asynchronous failure is " <> message (fromLeft asyncF)

  asyncF' <- attempt $ makeAff \reject resolve -> synchronousUnexpectedThrowError
  log $ "makeAff synchronous failure is " <> message (fromLeft asyncF')

  log "Success: makeAff is ok"

test_pure :: Test Unit
test_pure = do
  pure unit
  pure unit
  pure unit
  log "Success: Got all the way past 4 pures"

test_attempt :: Test Unit
test_attempt = do
  e <- attempt (throwError (error "Oh noes!"))
  either (const $ log "Success: Exception caught") (const $ log "Failure: Exception NOT caught!!!") e

test_apathize :: Test Unit
test_apathize = do
  apathize $ throwError (error "Oh noes!")
  log "Success: Exceptions don't stop the apathetic"

test_putTakeVar :: TestAVar Unit
test_putTakeVar = do
  v <- makeVar
  forkAff (later $ putVar v 1.0)
  a <- takeVar v
  log ("Success: Value " <> show a)

test_peekVar :: TestAVar Unit
test_peekVar = do
  v <- makeVar
  forkAff (later $ putVar v 1.0)
  a1 <- peekVar v
  a2 <- takeVar v
  when (a1 /= a2) do
    throwError (error "Something horrible went wrong - peeked var is not equal to taken var")
  log ("Success: Peeked value not consumed")

  w <- makeVar
  putVar w true
  b <- peekVar w
  when (not b) do
    throwError (error "Something horrible went wrong - peeked var is not true")
  log ("Success: Peeked value read from written var")

test_killFirstForked :: Test Unit
test_killFirstForked = do
  c <- forkAff (later' 100 $ pure "Failure: This should have been killed!")
  b <- c `cancel` (error "Just die")
  log (if b then "Success: Killed first forked" else "Failure: Couldn't kill first forked")

test_killVar :: TestAVar Unit
test_killVar = do
  v <- makeVar
  killVar v (error "DOA")
  e <- attempt $ takeVar v
  either (const $ log "Success: Killed queue dead") (const $ log "Failure: Oh noes, queue survived!") e

test_finally :: TestAVar Unit
test_finally = do
  v <- makeVar
  finally
    (putVar v 0)
    (putVar v 2)
  apathize $ finally
    (throwError (error "poof!") *> putVar v 666) -- this putVar should not get executed
    (putVar v 40)
  n1 <- takeVar v
  n2 <- takeVar v
  n3 <- takeVar v
  log $ if n1 + n2 + n3 == 42 then "Success: effects amount to 42."
                                else "Failure: Expected 42."

test_parRace :: TestAVar Unit
test_parRace = do
  s <- sequential (parallel (later' 100 $ pure "Success: Early bird got the worm") <|>
               parallel (later' 200 $ pure "Failure: Late bird got the worm"))
  log s

test_parError :: TestAVar Unit
test_parError = do
  e <- attempt $ sequential (parallel (throwError (error ("Oh noes!"))) *> pure unit)
  either (const $ log "Success: Exception propagated") (const $ log "Failure: Exception missing") e

test_parRaceKill1 :: TestAVar Unit
test_parRaceKill1 = do
  s <- sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
               parallel (later' 200 $ pure "Success: Early error was ignored in favor of late success"))
  log s

test_parRaceKill2 :: TestAVar Unit
test_parRaceKill2 = do
  e <- attempt $ sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
                         parallel (later' 200 $ throwError (error ("Oh noes!"))))
  either (const $ log "Success: Killing both kills it dead") (const $ log "Failure: It's alive!!!") e

test_semigroupCanceler :: Test Unit
test_semigroupCanceler =
  let
    c = Canceler (const (pure true)) <> Canceler (const (pure true))
  in do
    v <- cancel c (error "CANCEL")
    log (if v then "Success: Canceled semigroup composite canceler"
                     else "Failure: Could not cancel semigroup composite canceler")

test_cancelLater :: TestAVar Unit
test_cancelLater = do
  c <- forkAff $ (do pure "Binding"
                     _ <- later' 100 $ log ("Failure: Later was not canceled!")
                     pure "Binding")
  v <- cancel c (error "Cause")
  log (if v then "Success: Canceled later" else "Failure: Did not cancel later")

test_cancelLaunchLater :: forall e. Eff (console :: CONSOLE, err :: EXCEPTION | e) Unit
test_cancelLaunchLater = do
  c <- launchAff $ later' 100 $ log ("Failure: Later was not canceled!")
  void $ launchAff $ (do v <- cancel c (error "Cause")
                         log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))

test_cancelRunLater :: forall e. Eff (console :: CONSOLE | e) Unit
test_cancelRunLater = do
  c <- runAff (const (pure unit)) (const (pure unit)) $ later' 100 $ log ("Failure: Later was not canceled!")
  void $ try $ launchAff $ (do v <- cancel c (error "Cause")
                               log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))

test_cancelParallel :: TestAVar Unit
test_cancelParallel = do
  c  <- forkAff <<< sequential $ parallel (later' 100 $ log "Failure: #1 should not get through") <|>
                             parallel (later' 100 $ log "Failure: #2 should not get through")
  v  <- c `cancel` (error "Must cancel")
  log (if v then "Success: Canceling composite of two Parallel succeeded"
                   else "Failure: Canceling composite of two Parallel failed")

test_syncTailRecM :: TestAVar Unit
test_syncTailRecM = do
  v <- makeVar' false
  _ <- forkAff $ tailRecM go { n: 1000000, v }
  b <- takeVar v
  log (if b then "Success: Synchronous tailRecM resolved synchronously"
            else "Failure: Synchronous tailRecM resolved asynchronously")
  where
  go { n: 0, v } = do
    modifyVar (const true) v
    pure (Done 0)
  go { n, v } = pure (Loop { n: n - 1, v })

loopAndBounce :: forall eff. Int -> Aff (console :: CONSOLE | eff) Unit
loopAndBounce n = do
  res <- tailRecM go n
  log $ "Done: " <> show res
  where
  go 0 = pure (Done 0)
  go n | mod n 30000 == 0 = do
    later' 10 (pure unit)
    pure (Loop (n - 1))
  go n = pure (Loop (n - 1))

all :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
all n = do
  var <- makeVar' 0
  forkAll $ replicateArray n (modifyVar (_ + 1) var)
  count <- takeVar var
  log ("Forked " <> show count)

cancelAll :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
cancelAll n = do
  canceler <- forkAll $ replicateArray n (later' 100000 (log "oops"))
  canceled <- cancel canceler (error "bye")
  log ("Cancelled all: " <> show canceled)

delay :: forall eff. Int -> Aff eff Unit
delay n = later' n (pure unit)

main :: Eff (console :: CONSOLE, avar :: AVAR, err :: EXCEPTION) Unit
main = do
  Eff.log "Testing kill of later launched in separate Aff"
  test_cancelLaunchLater

  Eff.log "Testing kill of later run in separate Aff"
  test_cancelRunLater

  void $ runAff throwException (const (pure unit)) $ do
    log "Testing sequencing"
    test_sequencing 3

    log "Testing pure"
    test_pure

    log "Testing makeAff"
    test_makeAff

    log "Testing attempt"
    test_attempt

    log "Testing later"
    later $ log "Success: It happened later"

    log "Testing kill of later"
    test_cancelLater

    log "Testing kill of first forked"
    test_killFirstForked

    log "Testing apathize"
    test_apathize

    log "Testing semigroup canceler"
    test_semigroupCanceler

    log "Testing AVar - putVar, takeVar"
    test_putTakeVar

    log "Testing AVar - peekVar"
    test_peekVar

    log "Testing AVar killVar"
    test_killVar

    log "Testing finally"
    test_finally

    log "Test Parallel (*>)"
    test_parError

    log "Testing Parallel (<|>)"
    test_parRace

    log "Testing Parallel (<|>) - kill one"
    test_parRaceKill1

    log "Testing Parallel (<|>) - kill two"
    test_parRaceKill2

    log "Testing cancel of Parallel (<|>)"
    test_cancelParallel

    log "Testing synchronous tailRecM"
    test_syncTailRecM

    log "pre-delay"
    delay 1000
    log "post-delay"

    loopAndBounce 1000000

    all 100000

    cancelAll 100000

    log "Done testing"


add issue 1841 to search results

add issue 1841 to search results

{-
Copyright 2015 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 Test.SlamData.Feature.Test.Search where

import Prelude
import Control.Apply ((*>))
import Test.Feature.Log (successMsg)
import Test.SlamData.Feature.Expectations as Expect
import Test.SlamData.Feature.Monad (SlamFeature)
import Test.SlamData.Feature.Interactions as Interact
import Test.Feature.Scenario (scenario)

searchScenario :: String -> Array String -> SlamFeature Unit -> SlamFeature Unit
searchScenario =
  scenario
    "Search"
    (Interact.createWorkspaceInTestFolder "Search")
    (Interact.deleteFileInTestFolder "Untitled Workspace.slam"
       *> Interact.browseRootFolder)

test :: SlamFeature Unit
test = do
  searchScenario "Search for a city" [] do
    --Test.SlamData.Feature.Monad.waitTime 30000
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "springfield"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 10 "city" "SPRINGFIELD"
    successMsg "Successfully searched for a city"

  searchScenario "Search within results" ["https://slamdata.atlassian.net/browse/SD-1841"] do
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "springfield"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "OR"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 2 "city" "SPRINGFIELD"
    Expect.cardsInTableColumnInLastCardToContain 2 "state" "OR"
    successMsg "Successfully searched within results"

  searchScenario "Search with field names" [] do
    --Given.aDocument "/test-mount/testDb/zips"
    --  [ Map.fromFoldable
    --      [ Tuple "city" "WEST SPRINGFIELD"
    --      , Tuple "state" "OR"
    --      , Tuple "pop" "30001"
    --      ]
    --  , Map.fromFoldable
    --      [ Tuple "city" "WEST SPRINGFIELD"
    --      , Tuple "state" "OR"
    --      , Tuple "pop" "30000"
    --      ]
    --  , Map.fromFoldable
    --      [ Tuple "city" "DELAWARE"
    --      , Tuple "state" "OR"
    --      , Tuple "pop" "30001"
    --      ]
    --  , Map.fromFoldable
    --      [ Tuple "city" "WEST SPRINGFIELD"
    --      , Tuple "state" "CO"
    --      , Tuple "pop" "30001"
    --      ]
    --  ]
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard
      "city:springfield state:or pop:>30000"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 1 "city" "SPRINGFIELD"
    Expect.cardsInTableColumnInLastCardToContain 1 "state" "OR"
    Expect.cardsInTableColumnInLastCardToBeGT 1 "pop" "30000"
    successMsg "Successfully searched with field names"

  searchScenario "Suppress search results" [] do
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "city:portland -state:OR"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 10 "city" "PORTLAND"
    Expect.cardsInTableColumnInLastCardToNotEq 10 "state" "OR"
    successMsg "Successfully suppressed search results"

{-
Copyright 2015 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 Test.SlamData.Feature.Test.Search where

import Prelude
import Control.Apply ((*>))
import Test.Feature.Log (successMsg)
import Test.SlamData.Feature.Expectations as Expect
import Test.SlamData.Feature.Monad (SlamFeature)
import Test.SlamData.Feature.Interactions as Interact
import Test.Feature.Scenario (scenario)

searchScenario :: String -> Array String -> SlamFeature Unit -> SlamFeature Unit
searchScenario =
  scenario
    "Search"
    (Interact.createWorkspaceInTestFolder "Search")
    (Interact.deleteFileInTestFolder "Untitled Workspace.slam"
       *> Interact.browseRootFolder)

test :: SlamFeature Unit
test = do
  searchScenario "Search for a city" [] do
    --Test.SlamData.Feature.Monad.waitTime 30000
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "springfield"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 10 "city" "SPRINGFIELD"
    successMsg "Successfully searched for a city"

  searchScenario "Search within results" [] do
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "springfield"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "OR"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 2 "city" "SPRINGFIELD"
    Expect.cardsInTableColumnInLastCardToContain 2 "state" "OR"
    successMsg "Successfully searched within results"

  searchScenario "Search with field names" [] do
    --Given.aDocument "/test-mount/testDb/zips"
    --  [ Map.fromFoldable
    --      [ Tuple "city" "WEST SPRINGFIELD"
    --      , Tuple "state" "OR"
    --      , Tuple "pop" "30001"
    --      ]
    --  , Map.fromFoldable
    --      [ Tuple "city" "WEST SPRINGFIELD"
    --      , Tuple "state" "OR"
    --      , Tuple "pop" "30000"
    --      ]
    --  , Map.fromFoldable
    --      [ Tuple "city" "DELAWARE"
    --      , Tuple "state" "OR"
    --      , Tuple "pop" "30001"
    --      ]
    --  , Map.fromFoldable
    --      [ Tuple "city" "WEST SPRINGFIELD"
    --      , Tuple "state" "CO"
    --      , Tuple "pop" "30001"
    --      ]
    --  ]
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard
      "city:springfield state:or pop:>30000"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 1 "city" "SPRINGFIELD"
    Expect.cardsInTableColumnInLastCardToContain 1 "state" "OR"
    Expect.cardsInTableColumnInLastCardToBeGT 1 "pop" "30000"
    successMsg "Successfully searched with field names"

  searchScenario "Suppress search results" [] do
    Interact.insertOpenCardInLastDeck
    Interact.selectFileForLastOpenCard "/test-mount/testDb/zips"
    Interact.accessNextCardInLastDeck
    Interact.insertSearchCardInLastDeck
    Interact.provideSearchStringInLastSearchCard "city:portland -state:OR"
    Interact.accessNextCardInLastDeck
    Interact.insertTableCardInLastDeck
    Expect.cardsInTableColumnInLastCardToContain 10 "city" "PORTLAND"
    Expect.cardsInTableColumnInLastCardToNotEq 10 "state" "OR"
    successMsg "Successfully suppressed search results"


Fix relative UI-features having incorrect offsets

module Genetics.Browser.Track.Backend where
       -- ( demoBrowser
       -- , demoLegend
       -- , getDataDemo
       -- ) where

import Prelude

import Color (Color, black, white)
import Color.Scheme.Clrs (red)
import Control.Monad.Aff (Aff)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class (throwError)
import Data.Argonaut (Json, _Array)
import Data.Array ((..))
import Data.Array as Array
import Data.Either (Either(..))
import Data.Exists (Exists, runExists)
import Data.Filterable (partition, partitioned)
import Data.Foldable (class Foldable, fold, foldMap, foldl, length, maximum)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Int as Int
import Data.Lens (Getter', to, view, (^.), (^?))
import Data.List (List)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(Just, Nothing), fromMaybe, isJust, maybe)
import Data.Monoid (class Monoid, mempty)
import Data.Newtype (unwrap)
import Data.Pair (Pair(..))
import Data.Record as Record
import Data.Symbol (class IsSymbol, SProxy(..))
import Data.Traversable (class Traversable, traverse)
import Data.Tuple (Tuple(Tuple), snd, uncurry)
import Data.Unfoldable (unfoldr)
import Data.Variant (Variant, case_, inj, on, onMatch, prj)
import Genetics.Browser.Types (Bp, ChrId, Point)
import Genetics.Browser.Types.Coordinates (BrowserPoint, CoordSys, Interval, Normalized(Normalized), _BrowserIntervals, _Index, _Interval, intervalToScreen, intervalsOverlap, intervalsToMap)
import Genetics.Browser.View (Pixels)
import Graphics.Canvas as Canvas
import Graphics.Drawing (Drawing, circle, fillColor, filled, lineWidth, outlineColor, outlined, rectangle, translate)
import Graphics.Drawing as Drawing
import Graphics.Drawing.Font (font, sansSerif)
import Network.HTTP.Affjax as Affjax
import Type.Prelude (class RowLacks)

type BrowserView = Interval BrowserPoint

intersection :: forall k a b.
                Ord k
             => Map k a
             -> Map k b
             -> Map k a
intersection a b = Map.filterKeys (flip Map.member b) a

zipMaps :: forall k a b.
           Ord k
        => Map k a
        -> Map k b
        -> Map k (Tuple a b)
zipMaps a b =
  let kas = Array.unzip $ Map.toAscUnfoldable $ a `intersection` b
      kbs = Array.unzip $ Map.toAscUnfoldable $ b `intersection` a
      kabs = uncurry Array.zip $ map (Array.zip (snd kas)) kbs
  in Map.fromFoldable kabs

zipMapsWith :: forall k a b c.
               Ord k
            => (a -> b -> c)
            -> Map k a
            -> Map k b
            -> Map k c
zipMapsWith f a b = uncurry f <$> zipMaps a b

type ChrCtx r = Map ChrId (Record r)

_point = SProxy :: SProxy "point"
_range = SProxy :: SProxy "range"

type GenomePosV = Variant ( point :: Bp
                          , range :: Interval Bp )

type FeatureR r = ( position :: GenomePosV
                  , frameSize :: Bp
                  | r )
type Feature r = Record (FeatureR r)

type DrawingR  = ( point :: Drawing
                 , range :: Pixels -> Drawing )
type DrawingV  = Variant DrawingR

type HorPlaceR = ( point :: Normalized Number
                 , range :: Interval (Normalized Number) )
type HPos = Variant HorPlaceR

type Renderer a = { draw     :: a -> DrawingV
                  , horPlace :: a -> HPos
                  , verPlace :: a -> Normalized Number
                  }

type NormalizedGlyph = { drawing :: Variant DrawingR
                       , horPos  :: Variant HorPlaceR
                       , verPos  :: Normalized Number
                       }

horPlace :: forall r.
            Feature r
         -> HPos
horPlace {position, frameSize} =
  let f p = Normalized (unwrap $ p / frameSize)
  in case_
    # onMatch
      { point: inj _point <<< f
      , range: inj _range <<< (map f)
      }
    $ position

verPlace :: forall r.
            (Getter' (Feature r) (Normalized Number))
         -> Feature r
         -> Normalized Number
verPlace = view

render :: forall err a.
          Renderer a
       -> a
       -> NormalizedGlyph
render render a =
      { drawing: render.draw a
      , horPos:  render.horPlace a
      , verPos:  render.verPlace a
      }

type BatchedDrawings = { drawing :: Drawing, points :: Array Point }
type SingleDrawing   = { drawing :: Drawing, point :: Point }

type Glyph = Variant ( batched :: BatchedDrawings
                     , single  :: SingleDrawing  )

type FixedUIComponent    = CanvasReadyDrawing
type RelativeUIComponent = Interval BrowserPoint -> CanvasReadyDrawing

type Browser = { tracks     :: Array Glyph
               , relativeUI :: Array RelativeUIComponent
               , fixedUI    :: Array FixedUIComponent }

type CanvasSingleGlyph = { drawing :: Drawing, point :: Point }
type CanvasBatchGlyph  = { drawing :: Drawing, points :: Array Point }

type BatchedTrack = Array CanvasBatchGlyph

type CanvasReadyDrawing = Drawing

type BrowserTrack = Canvas.Dimensions
                 -> Interval BrowserPoint
                 -> CanvasReadyDrawing

-- Given a frame-normalized drawing, finalize it so it can be rendered to a canvas;
-- `width` is the width in pixels of the frame the drawing resides in.
resizeDrawing :: forall r.
                 { width :: Pixels | r }
              -> DrawingV
              -> Drawing
resizeDrawing {width} = case_
  # onMatch
     { point: (\x -> x)
     , range: (_ $ width) }

_LHS :: Getter' HPos (Normalized Number)
_LHS = to $ case_
         # onMatch { point: \x -> x, range: \(Pair l _) -> l}

renderNormalizedGlyphs ::  forall f r a.
                          Canvas.Dimensions
                       -> { width :: Pixels, offset :: Pixels }
                       -> Array NormalizedGlyph
                       -> { toBatch :: Array SingleDrawing
                          , singles :: Array SingleDrawing }
renderNormalizedGlyphs {height} {width, offset} gs =
    (\ {left, right} -> {toBatch: left, singles: right})
    $ partitioned $ map drawIt gs

  where drawIt {drawing, horPos, verPos} =
          let x = width * unwrap (horPos ^. _LHS)
              y = height * (1.0 - unwrap verPos)
              d = resizeDrawing {width} drawing
              res = { drawing: d, point: { x: (x + offset), y } }
          in if isJust $ prj _point drawing
                then Left res else Right res

batchDrawings :: Array SingleDrawing
              -> Array BatchedDrawings
batchDrawings = unfoldr f
  where f gs = Array.uncons gs >>= \ {head, tail} ->
                 let { no, yes } = partition (\ {drawing} -> head.drawing == drawing) tail
                     points = Array.cons head.point $ map _.point yes
                 in pure $ Tuple { drawing: head.drawing, points } no

batchNormalizedGlyphs :: forall f r a.
                         Canvas.Dimensions
                      -> { width :: Pixels, offset :: Pixels }
                      -> Array NormalizedGlyph
                      -> Array Glyph
batchNormalizedGlyphs h wo gs =
  let {toBatch, singles} = renderNormalizedGlyphs h wo gs
      batched = inj (SProxy :: SProxy "batched") <$> batchDrawings toBatch
      single  = inj (SProxy :: SProxy "single")  <$> singles
  in batched <> single

-- TODO rewrite relative UI features to use renderNormalizedglyphs;
--      this one seems kinda broken with the horizontal shifting
drawIntervalFeature :: forall f r a.
                       Foldable f
                    => Canvas.Dimensions
                    -> { width :: Pixels, offset :: Pixels }
                    -> f NormalizedGlyph
                    -> CanvasReadyDrawing
drawIntervalFeature {height} {width, offset} = foldMap drawIt
  where drawIt {drawing, horPos, verPos} =
          let x' = case_
                    # on _point (\x -> x)
                    # on _range (\(Pair l _) -> l)
                    $ horPos
              x = width * unwrap x'
              y = height * (1.0 - unwrap verPos)
              d = resizeDrawing {width} drawing
          in translate (x + offset) y d

-- | Returns the left-hand-edge offset, and width, in pixels,
-- | of each interval (chromosome) in the provided coordinate system
viewportIntervals :: forall i a r.
                     Ord i
                  => CoordSys i BrowserPoint
                  -> Canvas.Dimensions
                  -> Interval BrowserPoint
                  -> Map i { width :: Pixels, offset :: Pixels }
viewportIntervals cs cdim bView =
  intervalToScreen cdim bView <$> (view _Interval <$> intervalsToMap cs)

drawRelativeUI :: forall f i a.
                  Ord i
               => Foldable f
               => CoordSys i BrowserPoint
               -> Map i (f NormalizedGlyph)
               -> Canvas.Dimensions
               -> RelativeUIComponent
drawRelativeUI cs drawings cd v =
  fold $ zipMapsWith (drawIntervalFeature cd) (viewportIntervals cs cd v) drawings

pureTrackGlyphs :: forall f i a.
                   Ord i
                => CoordSys i BrowserPoint
                -> Map i (Array NormalizedGlyph)
                -> Canvas.Dimensions
                -> Interval BrowserPoint
                -> Map i (Array Glyph)
pureTrackGlyphs cs glyphs cd v =
  zipMapsWith (\v gs -> batchNormalizedGlyphs cd v gs) (viewportIntervals cs cd v) glyphs

renderTrackGlyphs ::  forall f i a.
                      Ord i
                  => Foldable f
                  => Traversable f
                  => CoordSys i BrowserPoint
                  -> Renderer a
                  -> Map i (f a)
                  -> Canvas.Dimensions
                  -> Interval BrowserPoint
                  -> Array Glyph
renderTrackGlyphs cs r trackData =
  let data' = map Array.fromFoldable trackData
      glyphs = (map <<< map) (render r) data'
  in \cd v -> fold $ pureTrackGlyphs cs glyphs cd v

horRulerTrack :: forall r.
                 { min :: Number, max :: Number, sig :: Number | r }
              -> Color
              -> BrowserTrack
horRulerTrack {min, max, sig} color f _ = outlined outline rulerDrawing
  where normY = (sig - min) / (max - min)
        y = f.height - (normY * f.height)
        outline = outlineColor color
        rulerDrawing = Drawing.path [{x: 0.0, y}, {x: f.width, y}]

chrLabelTrack :: CoordSys ChrId BrowserPoint
              -> Canvas.Dimensions
              -> RelativeUIComponent
chrLabelTrack cs = drawRelativeUI cs (Map.fromFoldable results)
  where mkLabel :: ChrId -> NormalizedGlyph
        mkLabel chr = { drawing: inj _point $ chrText chr
                      , horPos:  inj _point $ Normalized (0.5)
                      , verPos: Normalized (0.05) }

        font' = font sansSerif 12 mempty

        chrText :: ChrId -> Drawing
        chrText chr = Drawing.text font' zero zero (fillColor black) (unwrap chr)

        results :: Array _
        results = map (\x -> Tuple (x^._Index) [mkLabel (x^._Index)]) $ cs^._BrowserIntervals

boxesTrack :: Number
           -> CoordSys ChrId BrowserPoint
           -> Canvas.Dimensions
           -> RelativeUIComponent
boxesTrack h cs = drawRelativeUI cs $ map (const [glyph]) $ intervalsToMap cs
  where glyph :: NormalizedGlyph
        glyph = { drawing: inj _range draw
                , horPos:  inj _range $ Normalized <$> (Pair zero one)
                , verPos: Normalized one }
        draw = \w ->
             let rect = rectangle 0.0 0.0 w h
             in outlined (outlineColor black <> lineWidth 1.5) rect

featureInterval :: forall a. Feature a -> Interval Bp
featureInterval {position} = case_
  # onMatch
     { point: (\x -> Pair x x)
     , range: (\x -> x)
     }
  $ position

bumpFeatures :: forall f a l i o.
                Foldable f
             => Functor f
             => RowCons l Number (FeatureR i) (FeatureR o)
             => RowLacks l (FeatureR i)
             => IsSymbol l
             => Getter' (Feature a) Number
             -> SProxy l
             -> Bp
             -> f (Feature a)
             -> f (Feature i)
             -> f (Feature o)
bumpFeatures f l radius other = map bump
  where maxInRadius :: Interval Bp -> Number
        maxInRadius lr = fromMaybe 0.0 $ maximum
                          $ map (\g -> if intervalsOverlap (featureInterval g) lr
                                          then f `view` g else 0.0) other

        bump :: Record (FeatureR i) -> Record (FeatureR o)
        bump a =
          let y = maxInRadius (featureInterval a)
          in Record.insert l y a

groupToChrs :: forall a f rData.
               Monoid (f {chrId :: ChrId | rData})
            => Foldable f
            => Applicative f
            => f { chrId :: ChrId | rData }
            -> Map ChrId (f { chrId :: ChrId | rData })
groupToChrs = foldl (\chrs r@{chrId} -> Map.alter (add r) chrId chrs ) mempty
  where add x Nothing   = Just $ pure x
        add x (Just xs) = Just $ pure x <> xs

type VScaleRow r = ( min :: Number
                   , max :: Number
                   , sig :: Number
                   | r )

type VScale = { width :: Pixels
              , color :: Color
              | VScaleRow () }

drawVScale :: forall r.
              VScale
           -> Number
           -> Drawing
drawVScale vscale height =
  -- should have some padding here too; hardcode for now
  let hPad = vscale.width  / 5.0
      vPad = height / 10.0
      x = vscale.width / 2.0

      y1 = 0.0
      y2 = height

      n = (_ * 0.1) <<< Int.toNumber <$> (0 .. 10)

      p = Drawing.path [{x, y:y1}, {x, y:y2}]

      bar w y = Drawing.path [{x:x-w, y}, {x, y}]

      ps = foldMap (\i -> bar
                          (if i == 0.0 || i == 1.0 then 8.0 else 3.0)
                          (y1 + i*(y2-y1))) n

      ft = font sansSerif 10 mempty
      mkT y = Drawing.text ft (x-12.0) y (fillColor black)

      topLabel = mkT (y1-(0.5*vPad)) $ show vscale.max
      btmLabel = mkT (y2+vPad)       $ show vscale.min

  in outlined (outlineColor vscale.color <> lineWidth 2.0) (p <> ps)
     <> topLabel <> btmLabel

type LegendEntry = { text :: String, icon :: Drawing }

type Legend = { width :: Pixels
              , entries :: Array LegendEntry }

mkIcon :: Color -> String -> LegendEntry
mkIcon c text =
  let sh = circle (-2.5) (-2.5) 5.0
      icon = outlined (outlineColor c <> lineWidth 2.0) sh <>
             filled (fillColor c) sh
  in {text, icon}

drawLegendItem :: LegendEntry
               -> Drawing
drawLegendItem {text, icon} =
  let ft = font sansSerif 12 mempty
      t = Drawing.text ft 12.0 0.0 (fillColor black) text
  in icon <> t

drawLegend :: Legend
           -> Number
           -> Drawing
drawLegend {width, entries} height =
  let hPad = width  / 5.0
      vPad = height / 5.0
      n :: Int
      n = length entries
      x = hPad
      f :: Number -> { text :: String, icon :: Drawing } -> Drawing
      f y ic = translate x y $ drawLegendItem ic
      d = (height - 2.0*vPad) / (length entries)
      ds = mapWithIndex (\i ic -> f (vPad+(vPad*(Int.toNumber i))) ic) entries
  in fold ds

type Padding = { vertical :: Pixels
               , horizontal :: Pixels
               }

groupToMap :: forall i a f rData.
              Monoid (f a)
           => Ord i
           => Foldable f
           => Applicative f
           => (a -> i)
           -> f a
           -> Map i (f a)
groupToMap f = foldl (\grp a -> Map.alter (add a) (f a) grp ) mempty
  where add :: a -> Maybe (f a) -> Maybe (f a)
        add x xs = (pure $ pure x) <> xs

getData :: forall a i c.
           CoordSys i c
        -> (CoordSys i c -> Json -> Maybe a)
        -> String
        -> Aff _ (Array a)
getData cs p url = do
  json <- _.response <$> Affjax.get url

  maybe (throwError $ error $ "Error when parsing features from " <> url)
        pure
        $ json ^? _Array >>= traverse (p cs)

getDataGrouped :: forall a i c.
                  CoordSys ChrId c
               -> (CoordSys ChrId c -> Json -> Maybe _)
               -> String
               -> Aff _ (Map ChrId (Array _))
getDataGrouped cs p url = groupToChrs <$> getData cs p url

type TrackRow c a = ( url :: String
                    , parse :: c -> Json -> Maybe a
                    , render :: Renderer a )

type GWASTrack c a  = { vscale :: { | VScaleRow () }
                      | TrackRow c a }

type AnnotTrack c a = { getEntry :: a -> LegendEntry | TrackRow c a }

eqLegend a b = a.text == b.text

trackLegend :: forall f a.
               Foldable f
            => Functor f
            => (a -> LegendEntry)
            -> f a
            -> Array LegendEntry
trackLegend f as = Array.nubBy eqLegend $ Array.fromFoldable $ map f as

data Track a = Track (Map ChrId (Array a)) (Renderer a)

-- TODO handle vertical offsets of tracks here
renderTrack :: forall a.
               CoordSys ChrId BrowserPoint
            -> Canvas.Dimensions
            -> Interval BrowserPoint
            -> Track a
            -> Array Glyph
renderTrack cs cd v (Track as r) = renderTrackGlyphs cs r as cd v

browser :: CoordSys ChrId BrowserPoint
        -> Canvas.Dimensions
        -> Padding
        -> { legend :: Legend, vscale :: VScale }
        -> List (Exists Track)
        -> { tracks     :: Interval BrowserPoint -> Array Glyph
           , relativeUI :: Interval BrowserPoint -> Drawing
           , fixedUI    :: Drawing }
browser cs cdim padding ui inputTracks =
  let height = cdim.height - 2.0 * padding.vertical
      width  = cdim.width

      trackCanvas = { width: width - ui.vscale.width - ui.legend.width
                    , height }

      -- TODO make a type that corresponds to left-of-track and right-of-track to make this dynamic
      drawOverlay x w d =
        (translate x zero
         $ filled (fillColor white)
         $ rectangle zero zero w height )
        <> translate x padding.vertical
           d

      vScale = drawOverlay
                 zero
                 ui.vscale.width
                 (drawVScale ui.vscale height)

      legend = drawOverlay
                 (cdim.width - ui.legend.width)
                 ui.legend.width
                 (drawLegend ui.legend height)

      fixedUI = vScale <> legend

      tracks :: Interval BrowserPoint -> Array Glyph
      tracks v = foldMap (runExists (\t -> renderTrack cs trackCanvas v t)) inputTracks

      chrLabels = chrLabelTrack cs trackCanvas
      ruler     = horRulerTrack ui.vscale red trackCanvas
      boxes     = boxesTrack height cs trackCanvas

      relativeUI = chrLabels
                <> translate 0.0 padding.vertical <<< (ruler <> boxes)

  in { tracks
     , relativeUI
     , fixedUI
     }

module Genetics.Browser.Track.Backend where
       -- ( demoBrowser
       -- , demoLegend
       -- , getDataDemo
       -- ) where

import Prelude

import Color (Color, black, white)
import Color.Scheme.Clrs (red)
import Control.Monad.Aff (Aff)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class (throwError)
import Data.Argonaut (Json, _Array)
import Data.Array ((..))
import Data.Array as Array
import Data.Either (Either(..))
import Data.Exists (Exists, runExists)
import Data.Filterable (partition, partitioned)
import Data.Foldable (class Foldable, fold, foldMap, foldl, length, maximum)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Int as Int
import Data.Lens (Getter', to, view, (^.), (^?))
import Data.List (List)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(Just, Nothing), fromMaybe, isJust, maybe)
import Data.Monoid (class Monoid, mempty)
import Data.Newtype (unwrap)
import Data.Pair (Pair(..))
import Data.Record as Record
import Data.Symbol (class IsSymbol, SProxy(..))
import Data.Traversable (class Traversable, traverse)
import Data.Tuple (Tuple(Tuple), snd, uncurry)
import Data.Unfoldable (unfoldr)
import Data.Variant (Variant, case_, inj, on, onMatch, prj)
import Genetics.Browser.Types (Bp, ChrId, Point)
import Genetics.Browser.Types.Coordinates (BrowserPoint, CoordSys, Interval, Normalized(Normalized), _BrowserIntervals, _Index, _Interval, intervalToScreen, intervalsOverlap, intervalsToMap)
import Genetics.Browser.View (Pixels)
import Graphics.Canvas as Canvas
import Graphics.Drawing (Drawing, circle, fillColor, filled, lineWidth, outlineColor, outlined, rectangle, translate)
import Graphics.Drawing as Drawing
import Graphics.Drawing.Font (font, sansSerif)
import Network.HTTP.Affjax as Affjax
import Type.Prelude (class RowLacks)

type BrowserView = Interval BrowserPoint

intersection :: forall k a b.
                Ord k
             => Map k a
             -> Map k b
             -> Map k a
intersection a b = Map.filterKeys (flip Map.member b) a

zipMaps :: forall k a b.
           Ord k
        => Map k a
        -> Map k b
        -> Map k (Tuple a b)
zipMaps a b =
  let kas = Array.unzip $ Map.toAscUnfoldable $ a `intersection` b
      kbs = Array.unzip $ Map.toAscUnfoldable $ b `intersection` a
      kabs = uncurry Array.zip $ map (Array.zip (snd kas)) kbs
  in Map.fromFoldable kabs

zipMapsWith :: forall k a b c.
               Ord k
            => (a -> b -> c)
            -> Map k a
            -> Map k b
            -> Map k c
zipMapsWith f a b = uncurry f <$> zipMaps a b

type ChrCtx r = Map ChrId (Record r)

_point = SProxy :: SProxy "point"
_range = SProxy :: SProxy "range"

type GenomePosV = Variant ( point :: Bp
                          , range :: Interval Bp )

type FeatureR r = ( position :: GenomePosV
                  , frameSize :: Bp
                  | r )
type Feature r = Record (FeatureR r)

type DrawingR  = ( point :: Drawing
                 , range :: Pixels -> Drawing )
type DrawingV  = Variant DrawingR

type HorPlaceR = ( point :: Normalized Number
                 , range :: Interval (Normalized Number) )
type HPos = Variant HorPlaceR

type Renderer a = { draw     :: a -> DrawingV
                  , horPlace :: a -> HPos
                  , verPlace :: a -> Normalized Number
                  }

type NormalizedGlyph = { drawing :: Variant DrawingR
                       , horPos  :: Variant HorPlaceR
                       , verPos  :: Normalized Number
                       }

horPlace :: forall r.
            Feature r
         -> HPos
horPlace {position, frameSize} =
  let f p = Normalized (unwrap $ p / frameSize)
  in case_
    # onMatch
      { point: inj _point <<< f
      , range: inj _range <<< (map f)
      }
    $ position

verPlace :: forall r.
            (Getter' (Feature r) (Normalized Number))
         -> Feature r
         -> Normalized Number
verPlace = view

render :: forall err a.
          Renderer a
       -> a
       -> NormalizedGlyph
render render a =
      { drawing: render.draw a
      , horPos:  render.horPlace a
      , verPos:  render.verPlace a
      }

type BatchedDrawings = { drawing :: Drawing, points :: Array Point }
type SingleDrawing   = { drawing :: Drawing, point :: Point }

type Glyph = Variant ( batched :: BatchedDrawings
                     , single  :: SingleDrawing  )

type FixedUIComponent    = CanvasReadyDrawing
type RelativeUIComponent = Interval BrowserPoint -> CanvasReadyDrawing

type Browser = { tracks     :: Array Glyph
               , relativeUI :: Array RelativeUIComponent
               , fixedUI    :: Array FixedUIComponent }

type CanvasSingleGlyph = { drawing :: Drawing, point :: Point }
type CanvasBatchGlyph  = { drawing :: Drawing, points :: Array Point }

type BatchedTrack = Array CanvasBatchGlyph

type CanvasReadyDrawing = Drawing

type BrowserTrack = Canvas.Dimensions
                 -> Interval BrowserPoint
                 -> CanvasReadyDrawing

-- Given a frame-normalized drawing, finalize it so it can be rendered to a canvas;
-- `width` is the width in pixels of the frame the drawing resides in.
resizeDrawing :: forall r.
                 { width :: Pixels | r }
              -> DrawingV
              -> Drawing
resizeDrawing {width} = case_
  # onMatch
     { point: (\x -> x)
     , range: (_ $ width) }

_LHS :: Getter' HPos (Normalized Number)
_LHS = to $ case_
         # onMatch { point: \x -> x, range: \(Pair l _) -> l}

renderNormalizedGlyphs ::  forall f r a.
                          Canvas.Dimensions
                       -> { width :: Pixels, offset :: Pixels }
                       -> Array NormalizedGlyph
                       -> { toBatch :: Array SingleDrawing
                          , singles :: Array SingleDrawing }
renderNormalizedGlyphs {height} {width, offset} gs =
    (\ {left, right} -> {toBatch: left, singles: right})
    $ partitioned $ map drawIt gs

  where drawIt {drawing, horPos, verPos} =
          let x = width * unwrap (horPos ^. _LHS)
              y = height * (1.0 - unwrap verPos)
              d = resizeDrawing {width} drawing
              res = { drawing: d, point: { x: (x + offset), y } }
          in if isJust $ prj _point drawing
                then Left res else Right res

batchDrawings :: Array SingleDrawing
              -> Array BatchedDrawings
batchDrawings = unfoldr f
  where f gs = Array.uncons gs >>= \ {head, tail} ->
                 let { no, yes } = partition (\ {drawing} -> head.drawing == drawing) tail
                     points = Array.cons head.point $ map _.point yes
                 in pure $ Tuple { drawing: head.drawing, points } no

batchNormalizedGlyphs :: forall f r a.
                         Canvas.Dimensions
                      -> { width :: Pixels, offset :: Pixels }
                      -> Array NormalizedGlyph
                      -> Array Glyph
batchNormalizedGlyphs h wo gs =
  let {toBatch, singles} = renderNormalizedGlyphs h wo gs
      batched = inj (SProxy :: SProxy "batched") <$> batchDrawings toBatch
      single  = inj (SProxy :: SProxy "single")  <$> singles
  in batched <> single

-- TODO rewrite relative UI features to use renderNormalizedglyphs;
--      this one seems kinda broken with the horizontal shifting
drawIntervalFeature :: forall f r a.
                       Foldable f
                    => Canvas.Dimensions
                    -> { width :: Pixels, offset :: Pixels }
                    -> f NormalizedGlyph
                    -> CanvasReadyDrawing
drawIntervalFeature {height} {width, offset} = foldMap drawIt
  where drawIt {drawing, horPos, verPos} =
          let x' = case_
                    # on _point (\x -> x)
                    # on _range (\(Pair l _) -> l)
                    $ horPos
              x = width * unwrap x'
              y = height * (1.0 - unwrap verPos)
              d = resizeDrawing {width} drawing
          in translate (x + offset) y d

-- | Returns the left-hand-edge offset, and width, in pixels,
-- | of each interval (chromosome) in the provided coordinate system
viewportIntervals :: forall i a r.
                     Ord i
                  => CoordSys i BrowserPoint
                  -> Canvas.Dimensions
                  -> Interval BrowserPoint
                  -> Map i { width :: Pixels, offset :: Pixels }
viewportIntervals cs cdim bView =
  intervalToScreen cdim bView <$> (view _Interval <$> intervalsToMap cs)

drawRelativeUI :: forall f i a.
                  Ord i
               => Foldable f
               => CoordSys i BrowserPoint
               -> Map i (f NormalizedGlyph)
               -> Canvas.Dimensions
               -> RelativeUIComponent
drawRelativeUI cs drawings cd v =
  fold $ zipMapsWith (drawIntervalFeature cd) (viewportIntervals cs cd v) drawings

pureTrackGlyphs :: forall f i a.
                   Ord i
                => CoordSys i BrowserPoint
                -> Map i (Array NormalizedGlyph)
                -> Canvas.Dimensions
                -> Interval BrowserPoint
                -> Map i (Array Glyph)
pureTrackGlyphs cs glyphs cd v =
  zipMapsWith (\v gs -> batchNormalizedGlyphs cd v gs) (viewportIntervals cs cd v) glyphs

renderTrackGlyphs ::  forall f i a.
                      Ord i
                  => Foldable f
                  => Traversable f
                  => CoordSys i BrowserPoint
                  -> Renderer a
                  -> Map i (f a)
                  -> Canvas.Dimensions
                  -> Interval BrowserPoint
                  -> Array Glyph
renderTrackGlyphs cs r trackData =
  let data' = map Array.fromFoldable trackData
      glyphs = (map <<< map) (render r) data'
  in \cd v -> fold $ pureTrackGlyphs cs glyphs cd v

horRulerTrack :: forall r.
                 { min :: Number, max :: Number, sig :: Number | r }
              -> Color
              -> BrowserTrack
horRulerTrack {min, max, sig} color f _ = outlined outline rulerDrawing
  where normY = (sig - min) / (max - min)
        y = f.height - (normY * f.height)
        outline = outlineColor color
        rulerDrawing = Drawing.path [{x: 0.0, y}, {x: f.width, y}]

chrLabelTrack :: CoordSys ChrId BrowserPoint
              -> Canvas.Dimensions
              -> RelativeUIComponent
chrLabelTrack cs = drawRelativeUI cs (Map.fromFoldable results)
  where mkLabel :: ChrId -> NormalizedGlyph
        mkLabel chr = { drawing: inj _point $ chrText chr
                      , horPos:  inj _point $ Normalized (0.5)
                      , verPos: Normalized (0.05) }

        font' = font sansSerif 12 mempty

        chrText :: ChrId -> Drawing
        chrText chr = Drawing.text font' zero zero (fillColor black) (unwrap chr)

        results :: Array _
        results = map (\x -> Tuple (x^._Index) [mkLabel (x^._Index)]) $ cs^._BrowserIntervals

boxesTrack :: Number
           -> CoordSys ChrId BrowserPoint
           -> Canvas.Dimensions
           -> RelativeUIComponent
boxesTrack h cs = drawRelativeUI cs $ map (const [glyph]) $ intervalsToMap cs
  where glyph :: NormalizedGlyph
        glyph = { drawing: inj _range draw
                , horPos:  inj _range $ Normalized <$> (Pair zero one)
                , verPos: Normalized one }
        draw = \w ->
             let rect = rectangle 0.0 0.0 w h
             in outlined (outlineColor black <> lineWidth 1.5) rect

featureInterval :: forall a. Feature a -> Interval Bp
featureInterval {position} = case_
  # onMatch
     { point: (\x -> Pair x x)
     , range: (\x -> x)
     }
  $ position

bumpFeatures :: forall f a l i o.
                Foldable f
             => Functor f
             => RowCons l Number (FeatureR i) (FeatureR o)
             => RowLacks l (FeatureR i)
             => IsSymbol l
             => Getter' (Feature a) Number
             -> SProxy l
             -> Bp
             -> f (Feature a)
             -> f (Feature i)
             -> f (Feature o)
bumpFeatures f l radius other = map bump
  where maxInRadius :: Interval Bp -> Number
        maxInRadius lr = fromMaybe 0.0 $ maximum
                          $ map (\g -> if intervalsOverlap (featureInterval g) lr
                                          then f `view` g else 0.0) other

        bump :: Record (FeatureR i) -> Record (FeatureR o)
        bump a =
          let y = maxInRadius (featureInterval a)
          in Record.insert l y a

groupToChrs :: forall a f rData.
               Monoid (f {chrId :: ChrId | rData})
            => Foldable f
            => Applicative f
            => f { chrId :: ChrId | rData }
            -> Map ChrId (f { chrId :: ChrId | rData })
groupToChrs = foldl (\chrs r@{chrId} -> Map.alter (add r) chrId chrs ) mempty
  where add x Nothing   = Just $ pure x
        add x (Just xs) = Just $ pure x <> xs

type VScaleRow r = ( min :: Number
                   , max :: Number
                   , sig :: Number
                   | r )

type VScale = { width :: Pixels
              , color :: Color
              | VScaleRow () }

drawVScale :: forall r.
              VScale
           -> Number
           -> Drawing
drawVScale vscale height =
  -- should have some padding here too; hardcode for now
  let hPad = vscale.width  / 5.0
      vPad = height / 10.0
      x = vscale.width / 2.0

      y1 = 0.0
      y2 = height

      n = (_ * 0.1) <<< Int.toNumber <$> (0 .. 10)

      p = Drawing.path [{x, y:y1}, {x, y:y2}]

      bar w y = Drawing.path [{x:x-w, y}, {x, y}]

      ps = foldMap (\i -> bar
                          (if i == 0.0 || i == 1.0 then 8.0 else 3.0)
                          (y1 + i*(y2-y1))) n

      ft = font sansSerif 10 mempty
      mkT y = Drawing.text ft (x-12.0) y (fillColor black)

      topLabel = mkT (y1-(0.5*vPad)) $ show vscale.max
      btmLabel = mkT (y2+vPad)       $ show vscale.min

  in outlined (outlineColor vscale.color <> lineWidth 2.0) (p <> ps)
     <> topLabel <> btmLabel

type LegendEntry = { text :: String, icon :: Drawing }

type Legend = { width :: Pixels
              , entries :: Array LegendEntry }

mkIcon :: Color -> String -> LegendEntry
mkIcon c text =
  let sh = circle (-2.5) (-2.5) 5.0
      icon = outlined (outlineColor c <> lineWidth 2.0) sh <>
             filled (fillColor c) sh
  in {text, icon}

drawLegendItem :: LegendEntry
               -> Drawing
drawLegendItem {text, icon} =
  let ft = font sansSerif 12 mempty
      t = Drawing.text ft 12.0 0.0 (fillColor black) text
  in icon <> t

drawLegend :: Legend
           -> Number
           -> Drawing
drawLegend {width, entries} height =
  let hPad = width  / 5.0
      vPad = height / 5.0
      n :: Int
      n = length entries
      x = hPad
      f :: Number -> { text :: String, icon :: Drawing } -> Drawing
      f y ic = translate x y $ drawLegendItem ic
      d = (height - 2.0*vPad) / (length entries)
      ds = mapWithIndex (\i ic -> f (vPad+(vPad*(Int.toNumber i))) ic) entries
  in fold ds

type Padding = { vertical :: Pixels
               , horizontal :: Pixels
               }

groupToMap :: forall i a f rData.
              Monoid (f a)
           => Ord i
           => Foldable f
           => Applicative f
           => (a -> i)
           -> f a
           -> Map i (f a)
groupToMap f = foldl (\grp a -> Map.alter (add a) (f a) grp ) mempty
  where add :: a -> Maybe (f a) -> Maybe (f a)
        add x xs = (pure $ pure x) <> xs

getData :: forall a i c.
           CoordSys i c
        -> (CoordSys i c -> Json -> Maybe a)
        -> String
        -> Aff _ (Array a)
getData cs p url = do
  json <- _.response <$> Affjax.get url

  maybe (throwError $ error $ "Error when parsing features from " <> url)
        pure
        $ json ^? _Array >>= traverse (p cs)

getDataGrouped :: forall a i c.
                  CoordSys ChrId c
               -> (CoordSys ChrId c -> Json -> Maybe _)
               -> String
               -> Aff _ (Map ChrId (Array _))
getDataGrouped cs p url = groupToChrs <$> getData cs p url

type TrackRow c a = ( url :: String
                    , parse :: c -> Json -> Maybe a
                    , render :: Renderer a )

type GWASTrack c a  = { vscale :: { | VScaleRow () }
                      | TrackRow c a }

type AnnotTrack c a = { getEntry :: a -> LegendEntry | TrackRow c a }

eqLegend a b = a.text == b.text

trackLegend :: forall f a.
               Foldable f
            => Functor f
            => (a -> LegendEntry)
            -> f a
            -> Array LegendEntry
trackLegend f as = Array.nubBy eqLegend $ Array.fromFoldable $ map f as

data Track a = Track (Map ChrId (Array a)) (Renderer a)

-- TODO handle vertical offsets of tracks here
renderTrack :: forall a.
               CoordSys ChrId BrowserPoint
            -> Canvas.Dimensions
            -> Interval BrowserPoint
            -> Track a
            -> Array Glyph
renderTrack cs cd v (Track as r) = renderTrackGlyphs cs r as cd v

browser :: CoordSys ChrId BrowserPoint
        -> Canvas.Dimensions
        -> Padding
        -> { legend :: Legend, vscale :: VScale }
        -> List (Exists Track)
        -> { tracks     :: Interval BrowserPoint -> Array Glyph
           , relativeUI :: Interval BrowserPoint -> Drawing
           , fixedUI    :: Drawing }
browser cs cdim padding ui inputTracks =
  let height = cdim.height - 2.0 * padding.vertical
      width  = cdim.width

      trackCanvas = { width: width - ui.vscale.width - ui.legend.width
                    , height }

      -- TODO make a type that corresponds to left-of-track and right-of-track to make this dynamic
      drawOverlay x w d =
        (translate x zero
         $ filled (fillColor white)
         $ rectangle zero zero w cdim.height )
        <> translate x padding.vertical
           d

      vScale = drawOverlay
                 zero
                 ui.vscale.width
                 (drawVScale ui.vscale height)

      legend = drawOverlay
                 (cdim.width - ui.legend.width)
                 ui.legend.width
                 (drawLegend ui.legend height)

      fixedUI = vScale <> legend

      tracks :: Interval BrowserPoint -> Array Glyph
      tracks v = foldMap (runExists (\t -> renderTrack cs trackCanvas v t)) inputTracks

      chrLabels = chrLabelTrack cs cdim
      ruler     = horRulerTrack ui.vscale red cdim
      boxes     = boxesTrack height cs cdim

      relativeUI = chrLabels
                <> translate 0.0 padding.vertical <<< (ruler <> boxes)

  in { tracks
     , relativeUI
     , fixedUI
     }


Fix a typo in explorer

Fix a typo in explorer

module Explorer.I18n.EN where

import Explorer.I18n.Types (Translation)

translation :: Translation
translation =
    { common:
        { cBack: "Back"
        , cApi: "Api"
        , cADA: "ADA"
        , cBCshort: "BC"
        , cBCong: "Bitcoin"
        , cTransaction: "Transaction"
        , cTransactions: "Transactions"
        , cTransactionFeed: "Transactions Feed"
        , cAddress: "Address"
        , cAddresses: "Addresses"
        , cVersion: "version"
        , cCalculator: "Calculator"
        , cNetwork: "Network"
        , cSummary: "Summary"
        , cBlock: "Slot"
        , cGenesis: "Genesis block"
        , cHash: "Hash"
        , cHashes: "Hashes"
        , cEpoch: "Epoch"
        , cEpochs: "Epochs"
        , cSlot: "Slot"
        , cSlots: "Slots"
        , cAge: "Since"
        , cTotalSent: "Total Sent"
        , cBlockLead: "Slot leader"
        , cSize: "Size (bytes)"
        , cExpand: "Expand"
        , cCollapse: "Collapse"
        , cNoData: "No data"
        , cTitle: "Cardano Blockchain Explorer"
        , cCopyright: "Cardano Blockchain Explorer @2017"
        , cUnknown: "Unknown"
        , cTotalOutput: "Total Output"
        , cOf: "of"
        , cNotAvailable: "not available"
        , cLoading: "Loading..."
        , cBack2Dashboard: "Back to Dashboard"
        , cYes: "yes"
        , cNo: "no"
        , cDays: "days"
        , cHours: "hours"
        , cMinutes: "minutes"
        , cSeconds: "seconds"
        , cDateFormat: "MM/DD/YYYY HH:mm:ss"
        , cDecimalSeparator: "."
        , cGroupSeparator: ","
        }
    , navigation:
        { navHome: "Home"
        , navBlockchain: "Blockchain"
        , navMarket: "Market"
        , navCharts: "Charts"
        , navTools: "Tools"
        }
    , hero:
        { hrSubtitle: "Search addresses, transactions, epochs & slots on the Cardano network"
        , hrSearch: "Search for addresses, transactions, slots and epochs"
        , hrTime: "Time"
        }
    , dashboard:
        { dbTitle: "Dashboard"
        , dbLastBlocks: "Last slots"
        , dbLastBlocksDescription: "On {0} {1} transactions are generated"
        , dbPriceAverage: "Price (average)"
        , dbPriceForOne: "{0} for 1 {1}"
        , dbPriceSince: "{0} since yesterday."
        , dbTotalSupply: "Total supply"
        , dbTotalAmountOf: "Amount of {0} in the system."
        , dbTotalAmountOfTransactions: "Total amount of transactions detected in system since the beginning."
        , dbExploreBlocks: "Explore slots"
        , dbExploreTransactions: "Explore transactions"
        , dbBlockchainOffer: "What do we offer on our block explorer"
        , dbBlockSearch: "Slot search"
        , dbBlockSearchDescription: "Slot is a box where transactions are stored."
        , dbAddressSearch: "Address search"
        , dbAddressSearchDescription: "Address search"
        , dbTransactionSearch: "Transaction search"
        , dbTransactionSearchDescription: "Transaction is a transfer of coins from user 'A' to user 'B'."
        , dbApiDescription: "Our robust API is available in a variety of languages & SDKs."
        , dbGetAddress: "Get Address"
        , dbResponse: "Response"
        , dbCurl: "Curl"
        , dbNode: "Node"
        , dbJQuery: "jQuery"
        , dbGetApiKey: "Get API key"
        , dbMoreExamples: "See more examples"
        , dbAboutBlockchain: "About Blockchain"
        , dbAboutBlockchainDescription: "Blockchain API makes it easy yo build cryptocurrencies applications and features. We are focused on providing a platform that enables developers to create fast, scalable, secure services.

This API is free and unlimited while we are in beta. We are just getting started, and will be rolling out more endpoints and features in the coming weeks. We want to build the API you need, so please send us requests, suggestions, or just say hello."
        }
    , address:
        { addScan: "Scan this QR Code to copy address to clipboard"
        , addQrCode: "QR-Code"
        , addFinalBalance: "Final balance"
        , addNotFound: "Address does not exist."
        }
    , tx:
        { txTime: "Received time"
        , txIncluded: "Included in"
        , txRelayed: "Relayed by IP"
        , txEmpty: "No transactions"
        , txFees: "Transaction fee"
        , txNotFound: "Transaction does not exist."
        }
    , block:
        { blFees: "Fees"
        , blEstVolume: "Est. Volume"
        , blPrevBlock: "Previous slot"
        , blNextBlock: "Next slot"
        , blRoot: "Merkle root"
        , blEpochSlotNotFound: "An error occurred, epoch / slot cannot be found."
        , blSlotNotFound: "Slot does not exist."
        , blSlotEmpty: "Empty slot"
        }
    , genesisBlock:
        { gblNotFound: "Genesis block not found."
        , gblNumberRedeemedAddresses: "Redeemed addresses"
        , gblNumberNotRedeemedAddresses: "Addresses left to redeem"
        , gblNumberAddressesToRedeem: "Redeem addresses"
        , gblRedeemedAmountTotal: "Redeemed amount"
        , gblNonRedeemedAmountTotal: "Amount left to redeem"
        , gblFilterAll: "All"
        , gblFilterRedeemed: "Redeemed"
        , gblFilterNonRedeemed: "Not redeemed"
        , gblAddressesNotFound: "Addresses do not exists."
        , gblAddressesError: "Error while trying to load addresses."
        , gblAddressRedeemAmount: "Redeemed amount"
        , gblAddressIsRedeemed: "Redeemed"
        }
    , footer:
        { fooIohkSupportP: "IOHK supported project"
        , fooGithub: "Github"
        , fooEmail: "Email"
        , fooTwitter: "Twitter"
        , fooDaedalusPlatform: "Daedalus Platform"
        , fooWhyCardano: "Why Cardano"
        , fooCardanoRoadmap: "Cardano Roadmap"
        , fooCardanoSource: "Cardano Source"
        , fooCardanoFoundation: "Cardano Foundation"
        , fooCardanoFoundationYoutube: "Cardano Foundation YouTube"
        , fooCardanoFoundationTwitter: "Cardano Foundation Twitter"
        , fooCardanoHub: "Cardano Hub"
        , fooCardanoSlack: "Cardano Slack"
        , fooCardanoReddit: "Cardano Reddit"
        , fooCardanoCommunity: "Cardano Community"
        , fooCardanoDocumentation: "Cardano Documentation"
        , fooCardanoTestnet: "Cardano Testnet"
        , fooCardanoOpenSource: "Cardano is an Open Source project."
        , fooIOHK: "IOHK"
        , fooIOHKBlog: "IOHK blog"
        , fooIOHKYoutube: "IOHK YouTube"
        , fooDisclaimerPt1: "Cardano is a software platform ONLY and does not conduct any independent diligence on or substantive review of any blockchain asset, digital currency, cryptocurrency or associated funds. You are fully and solely responsible for evaluating your investments, for determining whether you will exchange blockchain assets based on your own, and for all your decisions as to whether to exchange blockchain assets with Cardano. In many cases, blockchain assets you exchange on the basis of your research may not increase in value, and may decrease in value. Similarly, blockchain assets you exchange on the basis of your research may increase in value after your exchange."
        , fooDisclaimerPt2: "Past performance is not indicative of future results. Any investment in blockchain assets involves the risk of loss of part or all of your investment. The value of the blockchain assets you exchange is subject to market and other investment risks."
        , fooProject: "The Project"
        , fooProtocol: "The Protocol"
        , fooFoundation: "The Foundation"
        , fooLearnMore: "Learn more"
        }
    , notfound:
        { nfTitle: "404"
        , nfDescription: "Page not found"
        }
    }

module Explorer.I18n.EN where

import Explorer.I18n.Types (Translation)

translation :: Translation
translation =
    { common:
        { cBack: "Back"
        , cApi: "Api"
        , cADA: "ADA"
        , cBCshort: "BC"
        , cBCong: "Bitcoin"
        , cTransaction: "Transaction"
        , cTransactions: "Transactions"
        , cTransactionFeed: "Transactions Feed"
        , cAddress: "Address"
        , cAddresses: "Addresses"
        , cVersion: "version"
        , cCalculator: "Calculator"
        , cNetwork: "Network"
        , cSummary: "Summary"
        , cBlock: "Slot"
        , cGenesis: "Genesis block"
        , cHash: "Hash"
        , cHashes: "Hashes"
        , cEpoch: "Epoch"
        , cEpochs: "Epochs"
        , cSlot: "Slot"
        , cSlots: "Slots"
        , cAge: "Since"
        , cTotalSent: "Total Sent"
        , cBlockLead: "Slot leader"
        , cSize: "Size (bytes)"
        , cExpand: "Expand"
        , cCollapse: "Collapse"
        , cNoData: "No data"
        , cTitle: "Cardano Blockchain Explorer"
        , cCopyright: "Cardano Blockchain Explorer @2017"
        , cUnknown: "Unknown"
        , cTotalOutput: "Total Output"
        , cOf: "of"
        , cNotAvailable: "not available"
        , cLoading: "Loading..."
        , cBack2Dashboard: "Back to Dashboard"
        , cYes: "yes"
        , cNo: "no"
        , cDays: "days"
        , cHours: "hours"
        , cMinutes: "minutes"
        , cSeconds: "seconds"
        , cDateFormat: "MM/DD/YYYY HH:mm:ss"
        , cDecimalSeparator: "."
        , cGroupSeparator: ","
        }
    , navigation:
        { navHome: "Home"
        , navBlockchain: "Blockchain"
        , navMarket: "Market"
        , navCharts: "Charts"
        , navTools: "Tools"
        }
    , hero:
        { hrSubtitle: "Search addresses, transactions, epochs & slots on the Cardano network"
        , hrSearch: "Search for addresses, transactions, slots and epochs"
        , hrTime: "Time"
        }
    , dashboard:
        { dbTitle: "Dashboard"
        , dbLastBlocks: "Last slots"
        , dbLastBlocksDescription: "On {0} {1} transactions are generated"
        , dbPriceAverage: "Price (average)"
        , dbPriceForOne: "{0} for 1 {1}"
        , dbPriceSince: "{0} since yesterday."
        , dbTotalSupply: "Total supply"
        , dbTotalAmountOf: "Amount of {0} in the system."
        , dbTotalAmountOfTransactions: "Total amount of transactions detected in system since the beginning."
        , dbExploreBlocks: "Explore slots"
        , dbExploreTransactions: "Explore transactions"
        , dbBlockchainOffer: "What do we offer on our block explorer"
        , dbBlockSearch: "Slot search"
        , dbBlockSearchDescription: "Slot is a box where transactions are stored."
        , dbAddressSearch: "Address search"
        , dbAddressSearchDescription: "Address search"
        , dbTransactionSearch: "Transaction search"
        , dbTransactionSearchDescription: "Transaction is a transfer of coins from user 'A' to user 'B'."
        , dbApiDescription: "Our robust API is available in a variety of languages & SDKs."
        , dbGetAddress: "Get Address"
        , dbResponse: "Response"
        , dbCurl: "Curl"
        , dbNode: "Node"
        , dbJQuery: "jQuery"
        , dbGetApiKey: "Get API key"
        , dbMoreExamples: "See more examples"
        , dbAboutBlockchain: "About Blockchain"
        , dbAboutBlockchainDescription: "Blockchain API makes it easy yo build cryptocurrencies applications and features. We are focused on providing a platform that enables developers to create fast, scalable, secure services.

This API is free and unlimited while we are in beta. We are just getting started, and will be rolling out more endpoints and features in the coming weeks. We want to build the API you need, so please send us requests, suggestions, or just say hello."
        }
    , address:
        { addScan: "Scan this QR Code to copy address to clipboard"
        , addQrCode: "QR-Code"
        , addFinalBalance: "Final balance"
        , addNotFound: "Address does not exist."
        }
    , tx:
        { txTime: "Received time"
        , txIncluded: "Included in"
        , txRelayed: "Relayed by IP"
        , txEmpty: "No transactions"
        , txFees: "Transaction fee"
        , txNotFound: "Transaction does not exist."
        }
    , block:
        { blFees: "Fees"
        , blEstVolume: "Est. Volume"
        , blPrevBlock: "Previous slot"
        , blNextBlock: "Next slot"
        , blRoot: "Merkle root"
        , blEpochSlotNotFound: "An error occurred, epoch / slot cannot be found."
        , blSlotNotFound: "Slot does not exist."
        , blSlotEmpty: "Empty slot"
        }
    , genesisBlock:
        { gblNotFound: "Genesis block not found."
        , gblNumberRedeemedAddresses: "Redeemed addresses"
        , gblNumberNotRedeemedAddresses: "Addresses left to redeem"
        , gblNumberAddressesToRedeem: "Redeem addresses"
        , gblRedeemedAmountTotal: "Redeemed amount"
        , gblNonRedeemedAmountTotal: "Amount left to redeem"
        , gblFilterAll: "All"
        , gblFilterRedeemed: "Redeemed"
        , gblFilterNonRedeemed: "Not redeemed"
        , gblAddressesNotFound: "Addresses do not exists."
        , gblAddressesError: "Error while trying to load addresses."
        , gblAddressRedeemAmount: "Redeemed amount"
        , gblAddressIsRedeemed: "Redeemed"
        }
    , footer:
        { fooIohkSupportP: "IOHK supported project"
        , fooGithub: "Github"
        , fooEmail: "Email"
        , fooTwitter: "Twitter"
        , fooDaedalusPlatform: "Daedalus Platform"
        , fooWhyCardano: "Why Cardano"
        , fooCardanoRoadmap: "Cardano Roadmap"
        , fooCardanoSource: "Cardano Source"
        , fooCardanoFoundation: "Cardano Foundation"
        , fooCardanoFoundationYoutube: "Cardano Foundation YouTube"
        , fooCardanoFoundationTwitter: "Cardano Foundation Twitter"
        , fooCardanoHub: "Cardano Hub"
        , fooCardanoSlack: "Cardano Slack"
        , fooCardanoReddit: "Cardano Reddit"
        , fooCardanoCommunity: "Cardano Community"
        , fooCardanoDocumentation: "Cardano Documentation"
        , fooCardanoTestnet: "Cardano Testnet"
        , fooCardanoOpenSource: "Cardano is an Open Source project."
        , fooIOHK: "IOHK"
        , fooIOHKBlog: "IOHK blog"
        , fooIOHKYoutube: "IOHK YouTube"
        , fooDisclaimerPt1: "Cardano is a software platform ONLY and does not conduct any independent diligence on or substantive review of any blockchain asset, digital currency, cryptocurrency or associated funds. You are fully and solely responsible for evaluating your investments, for determining whether you will exchange blockchain assets based on your own, and for all your decisions as to whether to exchange blockchain assets with Cardano. In many cases, blockchain assets you exchange on the basis of your research may not increase in value, and may decrease in value. Similarly, blockchain assets you exchange on the basis of your research may increase in value after your exchange."
        , fooDisclaimerPt2: "Past performance is not indicative of future results. Any investment in blockchain assets involves the risk of loss of part or all of your investment. The value of the blockchain assets you exchange is subject to market and other investment risks."
        , fooProject: "The Project"
        , fooProtocol: "The Protokol"
        , fooFoundation: "The Foundation"
        , fooLearnMore: "Learn more"
        }
    , notfound:
        { nfTitle: "404"
        , nfDescription: "Page not found"
        }
    }