Fix backwards compat decoding

Fix backwards compat decoding

{-
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.Setups.Chart.PivotTable.Model where

import SlamData.Prelude

import Data.Argonaut (JCursor(..), Json, class EncodeJson, class DecodeJson, decodeJson, (~>), (:=), isNull, (.?), jsonEmptyObject)
import Data.Argonaut.JCursor (insideOut)
import Data.Array as Array
import Data.Foldable as F
import Data.Newtype (un)
import Data.String as String

import SlamData.Workspace.Card.Setups.Dimension as D
import SlamData.Workspace.Card.Setups.Transform as T

import Test.StrongCheck.Arbitrary (class Arbitrary, arbitrary)
import Test.StrongCheck.Gen as Gen
import Test.StrongCheck.Data.Argonaut (runArbJCursor)

type Model =
  { dimensions ∷ Array GroupByDimension
  , columns ∷ Array ColumnDimension
  }

data Column = All | Column JCursor

type ColumnDimension = D.Dimension Void Column

type GroupByDimension = D.Dimension Void JCursor

initialModel ∷ Model
initialModel =
  { dimensions: []
  , columns: []
  }

eqModel ∷ Model → Model → Boolean
eqModel r1 r2 = r1.dimensions == r2.dimensions && r1.columns == r2.columns

genModel ∷ Gen.Gen Model
genModel = do
  dimensions ← map (map runArbJCursor ∘ un D.DimensionWithStaticCategory) <$> arbitrary
  columns ← map (un D.DimensionWithStaticCategory) <$> arbitrary
  pure { dimensions, columns }

encode ∷ Model → Json
encode r =
  "configType" := "pivot"
  ~> "dimensions" := r.dimensions
  ~> "columns" := r.columns
  ~> jsonEmptyObject

decode ∷ Json → Either String Model
decode js
  | isNull js = pure initialModel
  | otherwise = do
      obj ← decodeJson js
      configType ← obj .? "configType"
      unless (configType ≡ "pivot") do
        throwError "Not a valid pivot table configuration"
      dimensions ← traverse decodeDimension =<< obj .? "dimensions"
      columns ← traverse decodeColumn =<< obj .? "columns"
      pure { dimensions, columns }
  where
  decodeDimension ∷ Json → Either String GroupByDimension
  decodeDimension json = decodeJson json <|> decodeLegacyDimension json

  decodeLegacyDimension ∷ Json → Either String GroupByDimension
  decodeLegacyDimension json = do
    value ← decodeJson json
    pure $ D.projectionWithCategory (defaultJCursorCategory value) value

  decodeColumn ∷ Json → Either String ColumnDimension
  decodeColumn json = decodeJson json <|> decodeLegacyColumn json

  decodeLegacyColumn ∷ Json → Either String ColumnDimension
  decodeLegacyColumn json = do
    obj ← decodeJson json
    obj .? "columnType" >>= case _ of
      "value" → do
        value ← Column <$> obj .? "value"
        valueAggregation ← map T.Aggregation <$> obj .? "valueAggregation"
        pure $ D.Dimension
          (Just (defaultColumnCategory value))
          (D.Projection valueAggregation value)
      "count" → do
        pure $ D.Dimension
          (Just (D.Static "count"))
          (D.Projection (Just T.Count) All)
      ty → throwError $ "Invalid column type: " <> ty

derive instance eqColumn ∷ Eq Column
derive instance ordColumn ∷ Ord Column

instance arbitraryColumn ∷ Arbitrary Column where
  arbitrary = arbitrary >>= if _
    then pure All
    else Column ∘ runArbJCursor <$> arbitrary

instance encodeJsonColumn ∷ EncodeJson Column where
  encodeJson = case _ of
    All → "type" := "all" ~> jsonEmptyObject
    Column j → "type" := "column" ~> "value" := j ~> jsonEmptyObject

instance decodeJsonColumn ∷ DecodeJson Column where
  decodeJson json = do
    obj ← decodeJson json
    obj .? "type" >>= case _ of
      "all" → pure All
      "column" → Column <$> obj .? "value"
      ty → throwError $ "Invalid column type: " <> ty

isSimple ∷ Model → Boolean
isSimple { dimensions, columns } =
  Array.null dimensions && F.all simpleCol columns
  where
  simpleCol = case _ of
    D.Dimension _ (D.Projection (Just (T.Aggregation _)) _) → false
    _ → true

defaultJCursorCategory ∷ ∀ a. JCursor → D.Category a
defaultJCursorCategory = D.Static ∘ String.joinWith "_" ∘ go [] ∘ insideOut
  where
  go label (JField field _) = Array.cons field label
  go label (JIndex ix next) = go (Array.cons (show ix) label) next
  go label _ = Array.cons "value" label

defaultColumnCategory ∷ ∀ a. Column → D.Category a
defaultColumnCategory = case _ of
  All → D.Static "all"
  Column j → defaultJCursorCategory j

{-
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.Setups.Chart.PivotTable.Model where

import SlamData.Prelude

import Data.Argonaut (JCursor(..), Json, class EncodeJson, class DecodeJson, decodeJson, (~>), (:=), isNull, (.?), jsonEmptyObject)
import Data.Argonaut.JCursor (insideOut)
import Data.Array as Array
import Data.Foldable as F
import Data.Newtype (un)
import Data.String as String

import SlamData.Workspace.Card.Setups.Dimension as D
import SlamData.Workspace.Card.Setups.Transform as T

import Test.StrongCheck.Arbitrary (class Arbitrary, arbitrary)
import Test.StrongCheck.Gen as Gen
import Test.StrongCheck.Data.Argonaut (runArbJCursor)

type Model =
  { dimensions ∷ Array GroupByDimension
  , columns ∷ Array ColumnDimension
  }

data Column = All | Column JCursor

type ColumnDimension = D.Dimension Void Column

type GroupByDimension = D.Dimension Void JCursor

initialModel ∷ Model
initialModel =
  { dimensions: []
  , columns: []
  }

eqModel ∷ Model → Model → Boolean
eqModel r1 r2 = r1.dimensions == r2.dimensions && r1.columns == r2.columns

genModel ∷ Gen.Gen Model
genModel = do
  dimensions ← map (map runArbJCursor ∘ un D.DimensionWithStaticCategory) <$> arbitrary
  columns ← map (un D.DimensionWithStaticCategory) <$> arbitrary
  pure { dimensions, columns }

encode ∷ Model → Json
encode r =
  "configType" := "pivot"
  ~> "dimensions" := r.dimensions
  ~> "columns" := r.columns
  ~> jsonEmptyObject

decode ∷ Json → Either String Model
decode js
  | isNull js = pure initialModel
  | otherwise = do
      obj ← decodeJson js
      configType ← obj .? "configType"
      unless (configType ≡ "pivot") do
        throwError "Not a valid pivot table configuration"
      dimensions ← traverse decodeDimension =<< obj .? "dimensions"
      columns ← traverse decodeColumn =<< obj .? "columns"
      pure { dimensions, columns }
  where
  decodeDimension ∷ Json → Either String GroupByDimension
  decodeDimension json = decodeJson json <|> decodeLegacyDimension json

  decodeLegacyDimension ∷ Json → Either String GroupByDimension
  decodeLegacyDimension json = do
    value ← decodeJson json
    pure $ D.projectionWithCategory (defaultJCursorCategory value) value

  decodeColumn ∷ Json → Either String ColumnDimension
  decodeColumn json = decodeJson json <|> decodeLegacyColumn json

  decodeLegacyColumn ∷ Json → Either String ColumnDimension
  decodeLegacyColumn json = do
    obj ← decodeJson json
    obj .? "columnType" >>= case _ of
      "value" → do
        value ← Column <$> obj .? "value"
        valueAggregation ← T.Aggregation <$> obj .? "valueAggregation"
        pure $ D.Dimension
          (Just (defaultColumnCategory value))
          (D.Projection (Just valueAggregation) value)
      "count" →
        pure $ D.Dimension
          (Just (D.Static "count"))
          (D.Projection (Just T.Count) All)
      ty → throwError $ "Invalid column type: " <> ty

derive instance eqColumn ∷ Eq Column
derive instance ordColumn ∷ Ord Column

instance arbitraryColumn ∷ Arbitrary Column where
  arbitrary = arbitrary >>= if _
    then pure All
    else Column ∘ runArbJCursor <$> arbitrary

instance encodeJsonColumn ∷ EncodeJson Column where
  encodeJson = case _ of
    All → "type" := "all" ~> jsonEmptyObject
    Column j → "type" := "column" ~> "value" := j ~> jsonEmptyObject

instance decodeJsonColumn ∷ DecodeJson Column where
  decodeJson json = do
    obj ← decodeJson json
    obj .? "type" >>= case _ of
      "all" → pure All
      "column" → Column <$> obj .? "value"
      ty → throwError $ "Invalid column type: " <> ty

isSimple ∷ Model → Boolean
isSimple { dimensions, columns } =
  Array.null dimensions && F.all simpleCol columns
  where
  simpleCol = case _ of
    D.Dimension _ (D.Projection (Just (T.Aggregation _)) _) → false
    _ → true

defaultJCursorCategory ∷ ∀ a. JCursor → D.Category a
defaultJCursorCategory = D.Static ∘ String.joinWith "_" ∘ go [] ∘ insideOut
  where
  go label (JField field _) = Array.cons field label
  go label (JIndex ix next) = go (Array.cons (show ix) label) next
  go label _ = Array.cons "value" label

defaultColumnCategory ∷ ∀ a. Column → D.Category a
defaultColumnCategory = case _ of
  All → D.Static "all"
  Column j → defaultJCursorCategory j


Add abs, signum. resolves #66

Add abs, signum. resolves #66

module Data.Ord
  ( class Ord, compare
  , lessThan, (<)
  , lessThanOrEq, (<=)
  , greaterThan, (>)
  , greaterThanOrEq, (>=)
  , comparing
  , min, max
  , clamp
  , between
  , abs
  , signum
  , module Data.Ordering
  ) where

import Data.Eq (class Eq)
import Data.Function (on)
import Data.Ord.Unsafe (unsafeCompare)
import Data.Ordering (Ordering(..))
import Data.Ring (class Ring, zero, one, negate)
import Data.Unit (Unit)
import Data.Void (Void)

-- | The `Ord` type class represents types which support comparisons with a
-- | _total order_.
-- |
-- | `Ord` instances should satisfy the laws of total orderings:
-- |
-- | - Reflexivity: `a <= a`
-- | - Antisymmetry: if `a <= b` and `b <= a` then `a = b`
-- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`
class Eq a <= Ord a where
  compare :: a -> a -> Ordering

instance ordBoolean :: Ord Boolean where
  compare = unsafeCompare

instance ordInt :: Ord Int where
  compare = unsafeCompare

instance ordNumber :: Ord Number where
  compare = unsafeCompare

instance ordString :: Ord String where
  compare = unsafeCompare

instance ordChar :: Ord Char where
  compare = unsafeCompare

instance ordUnit :: Ord Unit where
  compare _ _ = EQ

instance ordVoid :: Ord Void where
  compare _ _ = EQ

instance ordArray :: Ord a => Ord (Array a) where
  compare = \xs ys -> compare 0 (ordArrayImpl toDelta xs ys)
    where
    toDelta x y =
      case compare x y of
        EQ -> 0
        LT -> 1
        GT -> -1

foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int

instance ordOrdering :: Ord Ordering where
  compare LT LT = EQ
  compare EQ EQ = EQ
  compare GT GT = EQ
  compare LT _  = LT
  compare EQ LT = GT
  compare EQ GT = LT
  compare GT _  = GT

-- | Test whether one value is _strictly less than_ another.
lessThan :: forall a. Ord a => a -> a -> Boolean
lessThan a1 a2 = case a1 `compare` a2 of
  LT -> true
  _ -> false

-- | Test whether one value is _strictly greater than_ another.
greaterThan :: forall a. Ord a => a -> a -> Boolean
greaterThan a1 a2 = case a1 `compare` a2 of
  GT -> true
  _ -> false

-- | Test whether one value is _non-strictly less than_ another.
lessThanOrEq :: forall a. Ord a => a -> a -> Boolean
lessThanOrEq a1 a2 = case a1 `compare` a2 of
  GT -> false
  _ -> true

-- | Test whether one value is _non-strictly greater than_ another.
greaterThanOrEq :: forall a. Ord a => a -> a -> Boolean
greaterThanOrEq a1 a2 = case a1 `compare` a2 of
  LT -> false
  _ -> true

infixl 4 lessThan as <
infixl 4 lessThanOrEq as <=
infixl 4 greaterThan as >
infixl 4 greaterThanOrEq as >=

-- | Compares two values by mapping them to a type with an `Ord` instance.
comparing :: forall a b. Ord b => (a -> b) -> (a -> a -> Ordering)
comparing f = compare `on` f

-- | Take the minimum of two values. If they are considered equal, the first
-- | argument is chosen.
min :: forall a. Ord a => a -> a -> a
min x y =
  case compare x y of
    LT -> x
    EQ -> x
    GT -> y

-- | Take the maximum of two values. If they are considered equal, the first
-- | argument is chosen.
max :: forall a. Ord a => a -> a -> a
max x y =
  case compare x y of
    LT -> y
    EQ -> x
    GT -> x

-- | Clamp a value between a minimum and a maximum. For example:
-- |
-- | ``` purescript
-- | let f = clamp 0 10
-- | f (-5) == 0
-- | f 5    == 5
-- | f 15   == 10
-- | ```
clamp :: forall a. Ord a => a -> a -> a -> a
clamp low hi x = min hi (max low x)

-- | Test whether a value is between a minimum and a maximum (inclusive).
-- | For example:
-- |
-- | ``` purescript
-- | let f = between 0 10
-- | f 0    == true
-- | f (-5) == false
-- | f 5    == true
-- | f 10   == true
-- | f 15   == false
-- | ```
between :: forall a. Ord a => a -> a -> a -> Boolean
between low hi x
  | x < low = false
  | x > hi = false
  | true = true

-- | The absolute value function. `abs x` is defined as `if x >= zero then x
-- | else negate x`.
abs :: forall a. (Ord a, Ring a) => a -> a
abs x = if x >= zero then x else negate x

-- | The sign function; always evaluates to either `one` or `negate one`. For
-- | any `x`, we should have `signum x * abs x == x`.
signum :: forall a. (Ord a, Ring a) => a -> a
signum x = if x >= zero then one else negate one

module Data.Ord
  ( class Ord, compare
  , lessThan, (<)
  , lessThanOrEq, (<=)
  , greaterThan, (>)
  , greaterThanOrEq, (>=)
  , comparing
  , min, max
  , clamp
  , between
  , module Data.Ordering
  ) where

import Data.Eq (class Eq)
import Data.Function (on)
import Data.Ord.Unsafe (unsafeCompare)
import Data.Ordering (Ordering(..))
import Data.Ring (negate)
import Data.Unit (Unit)
import Data.Void (Void)

-- | The `Ord` type class represents types which support comparisons with a
-- | _total order_.
-- |
-- | `Ord` instances should satisfy the laws of total orderings:
-- |
-- | - Reflexivity: `a <= a`
-- | - Antisymmetry: if `a <= b` and `b <= a` then `a = b`
-- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`
class Eq a <= Ord a where
  compare :: a -> a -> Ordering

instance ordBoolean :: Ord Boolean where
  compare = unsafeCompare

instance ordInt :: Ord Int where
  compare = unsafeCompare

instance ordNumber :: Ord Number where
  compare = unsafeCompare

instance ordString :: Ord String where
  compare = unsafeCompare

instance ordChar :: Ord Char where
  compare = unsafeCompare

instance ordUnit :: Ord Unit where
  compare _ _ = EQ

instance ordVoid :: Ord Void where
  compare _ _ = EQ

instance ordArray :: Ord a => Ord (Array a) where
  compare = \xs ys -> compare 0 (ordArrayImpl toDelta xs ys)
    where
    toDelta x y =
      case compare x y of
        EQ -> 0
        LT -> 1
        GT -> -1

foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int

instance ordOrdering :: Ord Ordering where
  compare LT LT = EQ
  compare EQ EQ = EQ
  compare GT GT = EQ
  compare LT _  = LT
  compare EQ LT = GT
  compare EQ GT = LT
  compare GT _  = GT

-- | Test whether one value is _strictly less than_ another.
lessThan :: forall a. Ord a => a -> a -> Boolean
lessThan a1 a2 = case a1 `compare` a2 of
  LT -> true
  _ -> false

-- | Test whether one value is _strictly greater than_ another.
greaterThan :: forall a. Ord a => a -> a -> Boolean
greaterThan a1 a2 = case a1 `compare` a2 of
  GT -> true
  _ -> false

-- | Test whether one value is _non-strictly less than_ another.
lessThanOrEq :: forall a. Ord a => a -> a -> Boolean
lessThanOrEq a1 a2 = case a1 `compare` a2 of
  GT -> false
  _ -> true

-- | Test whether one value is _non-strictly greater than_ another.
greaterThanOrEq :: forall a. Ord a => a -> a -> Boolean
greaterThanOrEq a1 a2 = case a1 `compare` a2 of
  LT -> false
  _ -> true

infixl 4 lessThan as <
infixl 4 lessThanOrEq as <=
infixl 4 greaterThan as >
infixl 4 greaterThanOrEq as >=

-- | Compares two values by mapping them to a type with an `Ord` instance.
comparing :: forall a b. Ord b => (a -> b) -> (a -> a -> Ordering)
comparing f = compare `on` f

-- | Take the minimum of two values. If they are considered equal, the first
-- | argument is chosen.
min :: forall a. Ord a => a -> a -> a
min x y =
  case compare x y of
    LT -> x
    EQ -> x
    GT -> y

-- | Take the maximum of two values. If they are considered equal, the first
-- | argument is chosen.
max :: forall a. Ord a => a -> a -> a
max x y =
  case compare x y of
    LT -> y
    EQ -> x
    GT -> x

-- | Clamp a value between a minimum and a maximum. For example:
-- |
-- | ``` purescript
-- | let f = clamp 0 10
-- | f (-5) == 0
-- | f 5    == 5
-- | f 15   == 10
-- | ```
clamp :: forall a. Ord a => a -> a -> a -> a
clamp low hi x = min hi (max low x)

-- | Test whether a value is between a minimum and a maximum (inclusive).
-- | For example:
-- |
-- | ``` purescript
-- | let f = between 0 10
-- | f 0    == true
-- | f (-5) == false
-- | f 5    == true
-- | f 10   == true
-- | f 15   == false
-- | ```
between :: forall a. Ord a => a -> a -> a -> Boolean
between low hi x
  | x < low = false
  | x > hi = false
  | true = true


add title property for latest watched entry of a given show

module FrontEnd where

import Prelude

import CSS (backgroundImage, url)
import Control.MonadPlus (guard)
import Data.Array as Array
import Data.Array.NonEmpty as NEA
import Data.Either (Either(..), either, hush)
import Data.Foldable (maximumBy)
import Data.Function (on)
import Data.JSDate as JSDate
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(Nothing, Just), fromMaybe, isJust, isNothing, maybe)
import Data.Newtype (unwrap, wrap)
import Data.Set (Set, insert, member)
import Data.String (Pattern(Pattern), contains, toLower)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff)
import Effect.Class (class MonadEffect)
import Effect.Class.Console (error, errorShow, log)
import Effect.Unsafe (unsafePerformEffect)
import FrontEnd.Chart as Chart
import FrontEnd.Style (classNames)
import Global.Unsafe (unsafeEncodeURIComponent)
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.CSS (style)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.VDom.Driver as D
import Milkis as M
import Milkis.Impl.Window (windowFetch)
import NameParser (nameParser)
import Routes (GetRoute, PostRoute, apiRoutes)
import Simple.JSON as JSON
import Text.Parsing.StringParser (runParser)
import Types (Path(..), WatchedData)

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

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

unE :: forall a m. MonadEffect m => (a -> m Unit) -> JSON.E a -> m Unit
unE = either errorShow

data Dir = ASC | DSC
derive instance eqDir :: Eq Dir
data Col = TitleEpisode | Status
derive instance eqCol :: Eq Col
data Sorting = Sorting Col Dir | NoSorting

newtype ChartSeries = ChartSeries (Array ChartSeriesData)
newtype ChartSeriesData = ChartSeriesData
  { date :: String
  , value :: Int
  }

data RemoteTaskState
  = Standby
  | Working
  | Success
  | Failure

type State =
  { fileData :: Array FileData
  , latest ::  Latest
  , watched :: Array WatchedData
  , filterWatched :: Boolean
  , sorting :: Sorting
  , search :: String
  , deleteConfirmations :: Set Path
  , getIcons :: RemoteTaskState
  }

type FileData =
  { path :: Path
  , name :: Maybe String
  , episode :: Maybe String
  , created :: Maybe String
  , dateString :: Maybe String
  , jsDate :: Maybe JSDate.JSDate
  }

type Latest = Map (Maybe String) LatestEntry

type LatestEntry =
  { name :: Maybe String
  , episode :: Maybe String
  }

getDate :: String -> JSDate.JSDate
getDate dateString =
  -- parsing date is UTZ dependent (ergo effectful), but in our case, we really don't care
  unsafePerformEffect <<< JSDate.parse $ dateString

prepareFilesData :: Array Path -> Array WatchedData -> Array FileData
prepareFilesData paths watchedData =
  go <$> paths
  where
    go path@(Path pathString) = do
      let
        parsed = hush $ runParser nameParser pathString
        created = _.created <$> Array.find (\x -> x.path == path) watchedData
        jsDate = getDate <$> created
      { path
      , created
      , name: _.name <$> parsed
      , episode: _.episode <$> parsed
      , dateString: JSDate.toDateString <$> jsDate
      , jsDate
      }

prepareLatest :: Array FileData -> Array WatchedData -> Latest
prepareLatest xs watched =
  Map.fromFoldable entries
  where
    watched' = _.path <$> watched

    group = Array.groupBy (eq `on` _.name)
        <<< Array.sortWith _.name
        <<< Array.filter (\x -> Array.elem x.path watched')

    entries = mkEntry <$> group xs

    mkEntry :: NEA.NonEmptyArray FileData -> Tuple (Maybe String) LatestEntry
    mkEntry ys = do
      let head = NEA.head ys
      Tuple
        head.name
        { name: head.name
        , episode: _.episode =<< maximumBy (compare `on` _.episode) ys
        }

getLatest :: Maybe String -> Latest -> String
getLatest key latest =
  fromMaybe "No watched entries found" $ format <$> Map.lookup key latest
  where
    format x = "Latest watched of " <> (fromMaybe "" x.name) <> ": " <> (fromMaybe "Unknown episode" x.episode)

data Query a
  = Init a
  | FetchData a
  | GetIcons a
  | OpenFile Path a
  | SetWatched Path Boolean a
  | Filter (Maybe String) a
  | ChangeSorting Col a
  | Search String a
  | ClearSearch a
  | ToggleFilterWatched Boolean a
  | ConfirmDeletion Path a
  | Delete Path a

type ChildSlots =
  ( chart :: Chart.Slot Unit
  )

ui :: H.Component HH.HTML Query Unit Void Aff
ui =
  H.component
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    }
  where
    initialState :: State
    initialState =
      { fileData: mempty
      , latest: Map.empty
      , watched: mempty
      , filterWatched: false
      , sorting: NoSorting
      , search: mempty
      , deleteConfirmations: mempty
      , getIcons: Standby
      }

    render :: State -> H.ComponentHTML Query ChildSlots Aff
    render state =
      HH.div
        [ HP.class_ $ classNames.container ]
        $ [ HH.h1_ [ HH.text "Vidtracker" ]
          , heatmap
          , HH.div
              [ HP.class_ classNames.top ]
              [ HH.div [ HP.class_ classNames.topLeft ]
                  [ refreshButton
                  , getIconsButton
                  , filterCheckbox
                  , search
                  ]
              , HH.div [ HP.class_ classNames.topRight ] recentHistory
              ]
          , header
          ] <> files
      where
        recentHistory = do
          let
            recents
              = Array.take 5 <<< Array.reverse <<< Array.sortWith _.jsDate
              $ Array.filter (isJust <<< _.jsDate) state.fileData
            list = recents <#> \x -> HH.div_ [ HH.text (unwrap x.path) ]
          [ HH.h4_ [ HH.text "Recently watched:" ] ] <> list
        heatmap =
          HH.slot (SProxy :: SProxy "chart") unit Chart.component state.watched absurd
        refreshButton =
          HH.button
            [ HP.classes $
              [ classNames.refreshFiles
              , wrap "pure-button"
              ]
            , HE.onClick <<< HE.input_ $ FetchData
            ]
            [ HH.text "Refresh" ]
        getIconsButton =
          HH.button
            [ HP.classes $
              [ classNames.getIcons
              , wrap "pure-button"
              ]
            , HE.onClick <<< HE.input_ $ GetIcons
            ]
            [ HH.text
               $ "Run Get Icons"
              <> case state.getIcons of
                   Standby -> ": Standby"
                   Working -> ": Working..."
                   Success -> ": Success"
                   Failure -> ": Failed"
            ]
        filterCheckbox =
          HH.button
            [ HP.classes $
              [ classNames.filterWatched
              , wrap "pure-button"
              ] <> (guard state.filterWatched $> wrap "pure-button-primary")
            , HE.onClick <<< HE.input_ <<< ToggleFilterWatched <<< not $ state.filterWatched
            ]
            [ HH.text "Filter Watched" ]
        search =
          HH.div_
            $ [ HH.h4_ [ HH.text "Search" ]
              , HH.input
                  [ HP.value state.search
                  , HE.onValueInput (HE.input Search)
                  ]
              ] <> clear
        clear =
          guard (state.search /= "") $>
            HH.button
              [ HE.onClick $ HE.input_ ClearSearch ]
              [ HH.text "Clear" ]
        header =
          HH.div
            [ HP.class_ $ classNames.file]
            [ HH.h3
              [ HP.class_ $ classNames.dot
              ] []
            , HH.h3
              [ HP.class_ $ classNames.fileLink
              , HE.onClick $ HE.input_ (ChangeSorting TitleEpisode)
              ] [ HH.text $ "Title" <> displayTicker TitleEpisode ]
            , HH.h3
              [ HP.class_ $ classNames.fileEpisode
              , HE.onClick $ HE.input_ (ChangeSorting TitleEpisode)
              ] []
            , HH.h3
              [ HP.class_ $ classNames.fileButton
              , HE.onClick $ HE.input_ (ChangeSorting Status)
              ] [ HH.text $ "Status" <> displayTicker Status ]
            , HH.h3 [HP.class_ $ classNames.fileNote ] [ HH.text "Date" ]
            , HH.h3
              [ HP.class_ $ classNames.filterLink
              ] [ HH.text "" ]
            , HH.h3
              [ HP.class_ $ classNames.deleteLink
              ] [ HH.text "" ]
            ]
        files = file <$> applyTransforms state.fileData

        displayTicker col
          | Sorting col' dir <- state.sorting
          , asc <- dir == ASC
          , col' == col = if asc
            then " ASC"
            else " DSC"
          | otherwise = ""
        applyTransforms
            = applySorting
          <<< applySearchFiltering
          <<< applyWatchFiltering
        applyWatchFiltering = if state.filterWatched
          then Array.filter $ isNothing <<< _.created
          else identity
        applySearchFiltering = case state.search of
            "" -> identity
            x -> Array.filter $ \{ path: Path path } -> contains (Pattern $ toLower x) (toLower path)
        applySorting
          | Sorting col dir <- state.sorting
          , rev <- if dir == ASC
            then identity
            else Array.reverse
          , sort' <- case col of
            TitleEpisode -> \xs -> do
              let
                preGroup = Array.sortWith _.name xs
                grouped = Array.groupBy (\{name: nameA} {name: nameB} -> nameA == nameB) preGroup
                sorted = Array.sortWith _.episode <<< Array.fromFoldable <$> grouped
              join sorted
            Status -> Array.sortWith _.created
            _ -> identity
          = rev <<< sort'
          | otherwise = identity
        parseEpisodeNumber { path: Path path } = case runParser nameParser path of
          Right {episode} -> episode
          Left _ -> "999"
        file { path, created, name, episode, dateString } =
          HH.div
            [ HP.class_ $ classNames.file ]
            [ HH.span
              [ HP.class_ $ classNames.dot
              , style do
                case name of
                  Just s ->
                    backgroundImage (url $ "icons/" <> unsafeEncodeURIComponent s)
                  Nothing -> pure mempty
              ] []
            , HH.a
              [ HP.class_ classNames.fileLink
              , HP.title $ getLatest name state.latest
              , HE.onClick $ HE.input_ (OpenFile path) ]
              [ HH.text $ unwrap path ]
            , HH.span
                [ HP.class_ $ classNames.fileEpisode ]
                [ HH.text $ fromMaybe "" episode ]
            , HH.button
              [ HP.classes $
                [ classNames.fileButton
                , wrap "pure-button"
                , wrap $ maybe "" (const "pure-button-primary") dateString
                ]
              , HE.onClick $ HE.input_ (SetWatched path (not $ isJust dateString))
              ]
              [ HH.text $ maybe "not watched" (const "watched") dateString ]
            , HH.span
              [ HP.class_ $ classNames.fileNote ]
              [ HH.text $ fromMaybe "" dateString ]
            , HH.button
              [ HP.classes $
                [ classNames.filterLink
                , wrap "pure-button"
                ]
              , HE.onClick $ HE.input_ (Filter name)
              ]
              [ HH.text "set filter" ]
            , HH.button
              [ HP.classes $
                [ classNames.deleteLink
                , wrap "pure-button"
                , if deleteConfirmation
                    then classNames.deleteConfirmation
                    else wrap ""
                ]
              , HE.onClick $ HE.input_ $
                  if deleteConfirmation
                    then (Delete path)
                    else (ConfirmDeletion path)
              ]
              [ HH.text
                  if deleteConfirmation
                    then "Confirm"
                    else "Delete"
              ]
            ]
          where
            deleteConfirmation = member path state.deleteConfirmations

    eval :: Query ~> H.HalogenM State Query ChildSlots Void Aff
    eval (Init next) = do
      eval (FetchData next)

    eval (FetchData next) = do
      getResult >>= unE
        \{filesData: fd, watched: w, latest: l} -> do
          H.modify_ _ {fileData = fd, watched = w, latest = l}
      pure next
      where
        getResult = ado
          files <- get apiRoutes.files
          watched <- get apiRoutes.watched
          let
            filesData = prepareFilesData <$> files <*> watched
            latest = prepareLatest <$> filesData <*> watched
          in { filesData: _, watched: _, latest: _ } <$> filesData <*> watched <*> latest

    eval (GetIcons next) = do
      H.modify_ _ {getIcons = Working}
      result <- post apiRoutes.getIcons {}
      case result of
        Right {success} | success -> H.modify_ _ {getIcons = Success}
        _ -> H.modify_ _ {getIcons = Failure}
      pure next

    eval (OpenFile path next) = do
      _ <- post apiRoutes.open {path}
      pure next

    eval (SetWatched path flag next) = do
      _ <- post apiRoutes.update {path, watched: flag}
      eval (FetchData next)

    eval (Filter name next) = do
      case name of
        Nothing -> error "Can't filter by unknown name" *> pure next
        Just s -> eval $ Search s next

    eval (Search str next) = do
      H.modify_ _ {search = str}
      pure next

    eval (ClearSearch next) = do
      H.modify_ _ {search = ""}
      pure next

    eval (ChangeSorting col next)= do
      H.modify_ $ \s -> case s.sorting of
        Sorting curr dir | curr == col ->
          s {sorting = case dir of
              ASC -> Sorting col DSC
              DSC -> NoSorting
            }
        _ -> s {sorting = Sorting col ASC}
      pure next

    eval (ToggleFilterWatched flag next) = do
      H.modify_ _ {filterWatched = flag}
      pure next

    eval (ConfirmDeletion path next) = do
      H.modify_ \s -> s {deleteConfirmations = insert path s.deleteConfirmations}
      pure next

    eval (Delete path next) = do
      _ <- post apiRoutes.remove {path}
      eval (FetchData next)

main :: Effect Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  io <- D.runUI ui unit body

  log $ "Running"

module FrontEnd where

import Prelude

import CSS (backgroundImage, url)
import Control.MonadPlus (guard)
import Data.Array as Array
import Data.Either (Either(..), either, hush)
import Data.JSDate as JSDate
import Data.Maybe (Maybe(Nothing, Just), fromMaybe, isJust, isNothing, maybe)
import Data.Newtype (unwrap, wrap)
import Data.Set (Set, insert, member)
import Data.String (Pattern(Pattern), contains, toLower)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff)
import Effect.Class (class MonadEffect)
import Effect.Class.Console (error, errorShow, log)
import Effect.Unsafe (unsafePerformEffect)
import FrontEnd.Chart as Chart
import FrontEnd.Style (classNames)
import Global.Unsafe (unsafeEncodeURIComponent)
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.CSS (style)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.VDom.Driver as D
import Milkis as M
import Milkis.Impl.Window (windowFetch)
import NameParser (nameParser)
import Routes (GetRoute, PostRoute, apiRoutes)
import Simple.JSON as JSON
import Text.Parsing.StringParser (runParser)
import Types (Path(..), WatchedData)

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

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

unE :: forall a m. MonadEffect m => (a -> m Unit) -> JSON.E a -> m Unit
unE = either errorShow

data Dir = ASC | DSC
derive instance eqDir :: Eq Dir
data Col = TitleEpisode | Status
derive instance eqCol :: Eq Col
data Sorting = Sorting Col Dir | NoSorting

newtype ChartSeries = ChartSeries (Array ChartSeriesData)
newtype ChartSeriesData = ChartSeriesData
  { date :: String
  , value :: Int
  }

data RemoteTaskState
  = Standby
  | Working
  | Success
  | Failure

type State =
  { fileData :: Array FileData
  , watched :: Array WatchedData
  , filterWatched :: Boolean
  , sorting :: Sorting
  , search :: String
  , deleteConfirmations :: Set Path
  , getIcons :: RemoteTaskState
  }

type FileData =
  { path :: Path
  , name :: Maybe String
  , episode :: Maybe String
  , created :: Maybe String
  , dateString :: Maybe String
  , jsDate :: Maybe JSDate.JSDate
  }

getDate :: String -> JSDate.JSDate
getDate dateString =
  -- parsing date is UTZ dependent (ergo effectful), but in our case, we really don't care
  unsafePerformEffect <<< JSDate.parse $ dateString

prepareFilesData :: Array Path -> Array WatchedData -> Array FileData
prepareFilesData paths watchedData =
  go <$> paths
  where
    go path@(Path pathString) = do
      let
        parsed = hush $ runParser nameParser pathString
        created = _.created <$> Array.find (\x -> x.path == path) watchedData
        jsDate = getDate <$> created
      { path
      , created
      , name: _.name <$> parsed
      , episode: _.episode <$> parsed
      , dateString: JSDate.toDateString <$> jsDate
      , jsDate
      }

data Query a
  = Init a
  | FetchData a
  | GetIcons a
  | OpenFile Path a
  | SetWatched Path Boolean a
  | Filter (Maybe String) a
  | ChangeSorting Col a
  | Search String a
  | ClearSearch a
  | ToggleFilterWatched Boolean a
  | ConfirmDeletion Path a
  | Delete Path a

type ChildSlots =
  ( chart :: Chart.Slot Unit
  )

ui :: H.Component HH.HTML Query Unit Void Aff
ui =
  H.component
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    }
  where
    initialState :: State
    initialState =
      { fileData: mempty
      , watched: mempty
      , filterWatched: false
      , sorting: NoSorting
      , search: mempty
      , deleteConfirmations: mempty
      , getIcons: Standby
      }

    render :: State -> H.ComponentHTML Query ChildSlots Aff
    render state =
      HH.div
        [ HP.class_ $ classNames.container ]
        $ [ HH.h1_ [ HH.text "Vidtracker" ]
          , heatmap
          , HH.div
              [ HP.class_ classNames.top ]
              [ HH.div [ HP.class_ classNames.topLeft ]
                  [ refreshButton
                  , getIconsButton
                  , filterCheckbox
                  , search
                  ]
              , HH.div [ HP.class_ classNames.topRight ] recentHistory
              ]
          , header
          ] <> files
      where
        recentHistory = do
          let
            recents
              = Array.take 5 <<< Array.reverse <<< Array.sortWith _.jsDate
              $ Array.filter (isJust <<< _.jsDate) state.fileData
            list = recents <#> \x -> HH.div_ [ HH.text (unwrap x.path) ]
          [ HH.h4_ [ HH.text "Recently watched:" ] ] <> list
        heatmap =
          HH.slot (SProxy :: SProxy "chart") unit Chart.component state.watched absurd
        refreshButton =
          HH.button
            [ HP.classes $
              [ classNames.refreshFiles
              , wrap "pure-button"
              ]
            , HE.onClick <<< HE.input_ $ FetchData
            ]
            [ HH.text "Refresh" ]
        getIconsButton =
          HH.button
            [ HP.classes $
              [ classNames.getIcons
              , wrap "pure-button"
              ]
            , HE.onClick <<< HE.input_ $ GetIcons
            ]
            [ HH.text
               $ "Run Get Icons"
              <> case state.getIcons of
                   Standby -> ": Standby"
                   Working -> ": Working..."
                   Success -> ": Success"
                   Failure -> ": Failed"
            ]
        filterCheckbox =
          HH.button
            [ HP.classes $
              [ classNames.filterWatched
              , wrap "pure-button"
              ] <> (guard state.filterWatched $> wrap "pure-button-primary")
            , HE.onClick <<< HE.input_ <<< ToggleFilterWatched <<< not $ state.filterWatched
            ]
            [ HH.text "Filter Watched" ]
        search =
          HH.div_
            $ [ HH.h4_ [ HH.text "Search" ]
              , HH.input
                  [ HP.value state.search
                  , HE.onValueInput (HE.input Search)
                  ]
              ] <> clear
        clear =
          guard (state.search /= "") $>
            HH.button
              [ HE.onClick $ HE.input_ ClearSearch ]
              [ HH.text "Clear" ]
        header =
          HH.div
            [ HP.class_ $ classNames.file]
            [ HH.h3
              [ HP.class_ $ classNames.dot
              ] []
            , HH.h3
              [ HP.class_ $ classNames.fileLink
              , HE.onClick $ HE.input_ (ChangeSorting TitleEpisode)
              ] [ HH.text $ "Title" <> displayTicker TitleEpisode ]
            , HH.h3
              [ HP.class_ $ classNames.fileEpisode
              , HE.onClick $ HE.input_ (ChangeSorting TitleEpisode)
              ] []
            , HH.h3
              [ HP.class_ $ classNames.fileButton
              , HE.onClick $ HE.input_ (ChangeSorting Status)
              ] [ HH.text $ "Status" <> displayTicker Status ]
            , HH.h3 [HP.class_ $ classNames.fileNote ] [ HH.text "Date" ]
            , HH.h3
              [ HP.class_ $ classNames.filterLink
              ] [ HH.text "" ]
            , HH.h3
              [ HP.class_ $ classNames.deleteLink
              ] [ HH.text "" ]
            ]
        files = file <$> applyTransforms state.fileData

        displayTicker col
          | Sorting col' dir <- state.sorting
          , asc <- dir == ASC
          , col' == col = if asc
            then " ASC"
            else " DSC"
          | otherwise = ""
        applyTransforms
            = applySorting
          <<< applySearchFiltering
          <<< applyWatchFiltering
        applyWatchFiltering = if state.filterWatched
          then Array.filter $ isNothing <<< _.created
          else identity
        applySearchFiltering = case state.search of
            "" -> identity
            x -> Array.filter $ \{ path: Path path } -> contains (Pattern $ toLower x) (toLower path)
        applySorting
          | Sorting col dir <- state.sorting
          , rev <- if dir == ASC
            then identity
            else Array.reverse
          , sort' <- case col of
            TitleEpisode -> \xs -> do
              let
                preGroup = Array.sortWith _.name xs
                grouped = Array.groupBy (\{name: nameA} {name: nameB} -> nameA == nameB) preGroup
                sorted = Array.sortWith _.episode <<< Array.fromFoldable <$> grouped
              join sorted
            Status -> Array.sortWith _.created
            _ -> identity
          = rev <<< sort'
          | otherwise = identity
        parseEpisodeNumber { path: Path path } = case runParser nameParser path of
          Right {episode} -> episode
          Left _ -> "999"
        file { path, created, name, episode, dateString } =
          HH.div
            [ HP.class_ $ classNames.file ]
            [ HH.span
              [ HP.class_ $ classNames.dot
              , style do
                case name of
                  Just s ->
                    backgroundImage (url $ "icons/" <> unsafeEncodeURIComponent s)
                  Nothing -> pure mempty
              ] []
            , HH.a
              [ HP.class_ classNames.fileLink
              , HE.onClick $ HE.input_ (OpenFile path) ]
              [ HH.text $ unwrap path ]
            , HH.span
                [ HP.class_ $ classNames.fileEpisode ]
                [ HH.text $ fromMaybe "" episode ]
            , HH.button
              [ HP.classes $
                [ classNames.fileButton
                , wrap "pure-button"
                , wrap $ maybe "" (const "pure-button-primary") dateString
                ]
              , HE.onClick $ HE.input_ (SetWatched path (not $ isJust dateString))
              ]
              [ HH.text $ maybe "not watched" (const "watched") dateString ]
            , HH.span
              [ HP.class_ $ classNames.fileNote ]
              [ HH.text $ fromMaybe "" dateString ]
            , HH.button
              [ HP.classes $
                [ classNames.filterLink
                , wrap "pure-button"
                ]
              , HE.onClick $ HE.input_ (Filter name)
              ]
              [ HH.text "set filter" ]
            , HH.button
              [ HP.classes $
                [ classNames.deleteLink
                , wrap "pure-button"
                , if deleteConfirmation
                    then classNames.deleteConfirmation
                    else wrap ""
                ]
              , HE.onClick $ HE.input_ $
                  if deleteConfirmation
                    then (Delete path)
                    else (ConfirmDeletion path)
              ]
              [ HH.text
                  if deleteConfirmation
                    then "Confirm"
                    else "Delete"
              ]
            ]
          where
            deleteConfirmation = member path state.deleteConfirmations

    eval :: Query ~> H.HalogenM State Query ChildSlots Void Aff
    eval (Init next) = do
      eval (FetchData next)

    eval (FetchData next) = do
      getResult >>= unE
        \{filesData: fd, watched: w} -> do
          H.modify_ _ {fileData = fd, watched = w}
      pure next
      where
        getResult = do
          files <- get apiRoutes.files
          watched <- get apiRoutes.watched
          let filesData = prepareFilesData <$> files <*> watched
          pure $ { filesData: _, watched: _ } <$> filesData <*> watched

    eval (GetIcons next) = do
      H.modify_ _ {getIcons = Working}
      result <- post apiRoutes.getIcons {}
      case result of
        Right {success} | success -> H.modify_ _ {getIcons = Success}
        _ -> H.modify_ _ {getIcons = Failure}
      pure next

    eval (OpenFile path next) = do
      _ <- post apiRoutes.open {path}
      pure next

    eval (SetWatched path flag next) = do
      _ <- post apiRoutes.update {path, watched: flag}
      eval (FetchData next)

    eval (Filter name next) = do
      case name of
        Nothing -> error "Can't filter by unknown name" *> pure next
        Just s -> eval $ Search s next

    eval (Search str next) = do
      H.modify_ _ {search = str}
      pure next

    eval (ClearSearch next) = do
      H.modify_ _ {search = ""}
      pure next

    eval (ChangeSorting col next)= do
      H.modify_ $ \s -> case s.sorting of
        Sorting curr dir | curr == col ->
          s {sorting = case dir of
              ASC -> Sorting col DSC
              DSC -> NoSorting
            }
        _ -> s {sorting = Sorting col ASC}
      pure next

    eval (ToggleFilterWatched flag next) = do
      H.modify_ _ {filterWatched = flag}
      pure next

    eval (ConfirmDeletion path next) = do
      H.modify_ \s -> s {deleteConfirmations = insert path s.deleteConfirmations}
      pure next

    eval (Delete path next) = do
      _ <- post apiRoutes.remove {path}
      eval (FetchData next)

main :: Effect Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  io <- D.runUI ui unit body

  log $ "Running"


Allow arbitrary start and end for range

Allow arbitrary start and end for range

module Data.Array
  ( (!!)
  , snoc
  , singleton
  , head
  , last
  , tail
  , init
  , null
  , map
  , length
  , elem
  , elemIndex
  , elemLastIndex
  , append
  , concat
  , reverse
  , drop
  , take
  , insertAt
  , deleteAt
  , updateAt
  , concatMap
  , filter
  , range
  , zipWith
  , nub
  , nubBy
  , sort
  ) where

import Data.Maybe
import Prelude.Unsafe (unsafeIndex)

infixl 8 !!

(!!) :: forall a. [a] -> Number -> Maybe a
(!!) xs n =
  if n < 0 || n >= (length xs) || isInt n
    then Nothing
    else Just (xs `unsafeIndex` n)
  where
  isInt n = n /= complement (complement n)

foreign import snoc
  "function snoc(l) {\
  \  return function (e) {\
  \    var l1 = l.slice();\
  \    l1.push(e); \
  \    return l1;\
  \  };\
  \}" :: forall a. [a] -> a -> [a]

singleton :: forall a. a -> [a]
singleton a = [a]

head :: forall a. [a] -> Maybe a
head (x : _) = Just x
head _       = Nothing

last :: forall a. [a] -> Maybe a
last (x : []) = Just x
last (_ : xs) = last xs
last _        = Nothing

tail :: forall a. [a] -> Maybe [a]
tail (_ : xs) = Just xs
tail _        = Nothing

init :: forall a. [a] -> Maybe [a]
init [] = Nothing
init xs = Just (slice 0 (length xs - 1) xs)

null :: forall a. [a] -> Boolean
null [] = true
null _  = false

foreign import length
  "function length (xs) {\
  \  return xs.length;\
  \}" :: forall a. [a] -> Number

foreign import elem
  "function elem(e) {\
  \  return function (l) {\
  \    return l.indexOf(e) !== -1;\
  \  };\
  \}" :: forall a. a -> [a] -> Boolean

foreign import elemIndex
  "function elemIndex (e) {\
  \  return function (l) {\
  \    return l.indexOf(e);\
  \  };\
  \}" :: forall a. a -> [a] -> Number

foreign import elemLastIndex
  "function elemLastIndex (e) {\
  \  return function (l) {\
  \    return l.lastIndexOf(e);\
  \  };\
  \}" :: forall a. a -> [a] -> Number

foreign import append
  "function append (l1) {\
  \  return function (l2) {\
  \    return l1.concat(l2);\
  \  };\
  \}" :: forall a. [a] -> [a] -> [a]

foreign import concat
  "function concat (xss) {\
  \  var result = [];\
  \  for (var i = 0, l = xss.length; i < l; i++) {\
  \    result.push.apply(result, xss[i]);\
  \  }\
  \  return result;\
  \}" :: forall a. [[a]] -> [a]

foreign import reverse
  "function reverse (l) {\
  \  return l.slice().reverse();\
  \}" :: forall a. [a] -> [a]

foreign import drop
  "function drop (n) {\
  \  return function (l) {\
  \    return l.slice(n);\
  \  };\
  \}" :: forall a. Number -> [a] -> [a]

take :: forall a. Number -> [a] -> [a]
take n = slice 0 n

foreign import slice
  "function slice (s) {\
  \  return function (e) {\
  \    return function (l) {\
  \      return l.slice(s, e);\
  \    };\
  \  };\
  \}" :: forall a. Number -> Number -> [a] -> [a]

foreign import insertAt
  "function insertAt (index) {\
  \  return function (a) {\
  \    return function (l) {\
  \      var l1 = l.slice();\
  \      l1.splice(index, 0, a);\
  \      return l1;\
  \    }; \
  \  };\
  \}":: forall a. Number -> a -> [a] -> [a]

foreign import deleteAt
  "function deleteAt (index) {\
  \  return function (n) {\
  \    return function (l) {\
  \      var l1 = l.slice();\
  \      l1.splice(index, n);\
  \      return l1;\
  \    }; \
  \  };\
  \}":: forall a. Number -> Number -> [a] -> [a]

foreign import updateAt
  "function updateAt (index) {\
  \  return function (a) {\
  \    return function (l) {\
  \      var i = ~~index;\
  \      if (i < 0 || i >= l.length) return l;\
  \      var l1 = l.slice();\
  \      l1[i] = a;\
  \      return l1;\
  \    }; \
  \  };\
  \}":: forall a. Number -> a -> [a] -> [a]

foreign import concatMap
  "function concatMap (f) {\
  \  return function (arr) {\
  \    var result = [];\
  \    for (var i = 0, l = arr.length; i < l; i++) {\
  \      Array.prototype.push.apply(result, f(arr[i]));\
  \    }\
  \    return result;\
  \  };\
  \}" :: forall a b. (a -> [b]) -> [a] -> [b]

foreign import map
  "function map (f) {\
  \  return function (arr) {\
  \    var l = arr.length;\
  \    var result = new Array(l);\
  \    for (var i = 0; i < l; i++) {\
  \      result[i] = f(arr[i]);\
  \    }\
  \    return result;\
  \  };\
  \}" :: forall a b. (a -> b) -> [a] -> [b]

foreign import filter
  "function filter (f) {\
  \  return function (arr) {\
  \    var n = 0;\
  \    var result = [];\
  \    for (var i = 0, l = arr.length; i < l; i++) {\
  \      if (f(arr[i])) {\
  \        result[n++] = arr[i];\
  \      }\
  \    }\
  \    return result;\
  \  };\
  \}" :: forall a. (a -> Boolean) -> [a] -> [a]

foreign import range
  "function range (start) {\
  \  return function (end) {\
  \    var i = ~~start, e = ~~end;\
  \    var step = i > e ? -1 : 1;\
  \    var result = [i], n = 1;\
  \    while (i !== e) {\
  \      i += step;\
  \      result[n++] = i;\
  \    }\
  \    return result;\
  \  };\
  \}" :: Number -> Number -> [Number]

foreign import zipWith
  "function zipWith (f) {\
  \  return function (xs) {\
  \    return function (ys) {\
  \      var l = xs.length < ys.length ? xs.length : ys.length;\
  \      var result = new Array(l);\
  \      for (var i = 0; i < l; i++) {\
  \        result[i] = f(xs[i])(ys[i]);\
  \      }\
  \      return result;\
  \    };\
  \  };\
  \}" :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]

nub :: forall a. (Eq a) => [a] -> [a]
nub = nubBy (==)

nubBy :: forall a. (a -> a -> Boolean) -> [a] -> [a]
nubBy _ [] = []
nubBy (==) (x:xs) = x : nubBy (==) (filter (\y -> not (x == y)) xs)

sort :: forall a. (Ord a) => [a] -> [a]
sort xs = sortJS comp xs
  where
  comp x y = case compare x y of
    GT -> 1
    EQ -> 0
    LT -> -1

foreign import sortJS
  "function sortJS (f) {\
  \  return function (l) {\
  \    return l.slice().sort(function (x, y) {\
  \      return f(x)(y);\
  \    });\
  \  };\
  \}" :: forall a. (a -> a -> Number) -> [a] -> [a]

instance functorArray :: Functor [] where
  (<$>) = map

instance applyArray :: Apply [] where
  (<*>) = ap

instance applicativeArray :: Applicative [] where
  pure = singleton

instance bindArray :: Bind [] where
  (>>=) = flip concatMap

instance monadArray :: Monad []

instance semigroupArray :: Semigroup [a] where
  (<>) = append

instance alternativeArray :: Alternative [] where
  empty = []
  (<|>) = append

module Data.Array
  ( (!!)
  , snoc
  , singleton
  , head
  , last
  , tail
  , init
  , null
  , map
  , length
  , elem
  , elemIndex
  , elemLastIndex
  , append
  , concat
  , reverse
  , drop
  , take
  , insertAt
  , deleteAt
  , updateAt
  , concatMap
  , filter
  , range
  , zipWith
  , nub
  , nubBy
  , sort
  ) where

import Data.Maybe
import Prelude.Unsafe (unsafeIndex)

infixl 8 !!

(!!) :: forall a. [a] -> Number -> Maybe a
(!!) xs n =
  if n < 0 || n >= (length xs) || isInt n
    then Nothing
    else Just (xs `unsafeIndex` n)
  where
  isInt n = n /= complement (complement n)

foreign import snoc
  "function snoc(l) {\
  \  return function (e) {\
  \    var l1 = l.slice();\
  \    l1.push(e); \
  \    return l1;\
  \  };\
  \}" :: forall a. [a] -> a -> [a]

singleton :: forall a. a -> [a]
singleton a = [a]

head :: forall a. [a] -> Maybe a
head (x : _) = Just x
head _       = Nothing

last :: forall a. [a] -> Maybe a
last (x : []) = Just x
last (_ : xs) = last xs
last _        = Nothing

tail :: forall a. [a] -> Maybe [a]
tail (_ : xs) = Just xs
tail _        = Nothing

init :: forall a. [a] -> Maybe [a]
init [] = Nothing
init xs = Just (slice 0 (length xs - 1) xs)

null :: forall a. [a] -> Boolean
null [] = true
null _  = false

foreign import length
  "function length (xs) {\
  \  return xs.length;\
  \}" :: forall a. [a] -> Number

foreign import elem
  "function elem(e) {\
  \  return function (l) {\
  \    return l.indexOf(e) !== -1;\
  \  };\
  \}" :: forall a. a -> [a] -> Boolean

foreign import elemIndex
  "function elemIndex (e) {\
  \  return function (l) {\
  \    return l.indexOf(e);\
  \  };\
  \}" :: forall a. a -> [a] -> Number

foreign import elemLastIndex
  "function elemLastIndex (e) {\
  \  return function (l) {\
  \    return l.lastIndexOf(e);\
  \  };\
  \}" :: forall a. a -> [a] -> Number

foreign import append
  "function append (l1) {\
  \  return function (l2) {\
  \    return l1.concat(l2);\
  \  };\
  \}" :: forall a. [a] -> [a] -> [a]

foreign import concat
  "function concat (xss) {\
  \  var result = [];\
  \  for (var i = 0, l = xss.length; i < l; i++) {\
  \    result.push.apply(result, xss[i]);\
  \  }\
  \  return result;\
  \}" :: forall a. [[a]] -> [a]

foreign import reverse
  "function reverse (l) {\
  \  return l.slice().reverse();\
  \}" :: forall a. [a] -> [a]

foreign import drop
  "function drop (n) {\
  \  return function (l) {\
  \    return l.slice(n);\
  \  };\
  \}" :: forall a. Number -> [a] -> [a]

take :: forall a. Number -> [a] -> [a]
take n = slice 0 n

foreign import slice
  "function slice (s) {\
  \  return function (e) {\
  \    return function (l) {\
  \      return l.slice(s, e);\
  \    };\
  \  };\
  \}" :: forall a. Number -> Number -> [a] -> [a]

foreign import insertAt
  "function insertAt (index) {\
  \  return function (a) {\
  \    return function (l) {\
  \      var l1 = l.slice();\
  \      l1.splice(index, 0, a);\
  \      return l1;\
  \    }; \
  \  };\
  \}":: forall a. Number -> a -> [a] -> [a]

foreign import deleteAt
  "function deleteAt (index) {\
  \  return function (n) {\
  \    return function (l) {\
  \      var l1 = l.slice();\
  \      l1.splice(index, n);\
  \      return l1;\
  \    }; \
  \  };\
  \}":: forall a. Number -> Number -> [a] -> [a]

foreign import updateAt
  "function updateAt (index) {\
  \  return function (a) {\
  \    return function (l) {\
  \      var i = ~~index;\
  \      if (i < 0 || i >= l.length) return l;\
  \      var l1 = l.slice();\
  \      l1[i] = a;\
  \      return l1;\
  \    }; \
  \  };\
  \}":: forall a. Number -> a -> [a] -> [a]

foreign import concatMap
  "function concatMap (f) {\
  \  return function (arr) {\
  \    var result = [];\
  \    for (var i = 0, l = arr.length; i < l; i++) {\
  \      Array.prototype.push.apply(result, f(arr[i]));\
  \    }\
  \    return result;\
  \  };\
  \}" :: forall a b. (a -> [b]) -> [a] -> [b]

foreign import map
  "function map (f) {\
  \  return function (arr) {\
  \    var l = arr.length;\
  \    var result = new Array(l);\
  \    for (var i = 0; i < l; i++) {\
  \      result[i] = f(arr[i]);\
  \    }\
  \    return result;\
  \  };\
  \}" :: forall a b. (a -> b) -> [a] -> [b]

foreign import filter
  "function filter (f) {\
  \  return function (arr) {\
  \    var n = 0;\
  \    var result = [];\
  \    for (var i = 0, l = arr.length; i < l; i++) {\
  \      if (f(arr[i])) {\
  \        result[n++] = arr[i];\
  \      }\
  \    }\
  \    return result;\
  \  };\
  \}" :: forall a. (a -> Boolean) -> [a] -> [a]

range :: Number -> Number -> [Number]
range lo hi | lo > hi = []
range lo hi = lo : range (lo + 1) hi

foreign import zipWith
  "function zipWith (f) {\
  \  return function (xs) {\
  \    return function (ys) {\
  \      var l = xs.length < ys.length ? xs.length : ys.length;\
  \      var result = new Array(l);\
  \      for (var i = 0; i < l; i++) {\
  \        result[i] = f(xs[i])(ys[i]);\
  \      }\
  \      return result;\
  \    };\
  \  };\
  \}" :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]

nub :: forall a. (Eq a) => [a] -> [a]
nub = nubBy (==)

nubBy :: forall a. (a -> a -> Boolean) -> [a] -> [a]
nubBy _ [] = []
nubBy (==) (x:xs) = x : nubBy (==) (filter (\y -> not (x == y)) xs)

sort :: forall a. (Ord a) => [a] -> [a]
sort xs = sortJS comp xs
  where
  comp x y = case compare x y of
    GT -> 1
    EQ -> 0
    LT -> -1

foreign import sortJS
  "function sortJS (f) {\
  \  return function (l) {\
  \    return l.slice().sort(function (x, y) {\
  \      return f(x)(y);\
  \    });\
  \  };\
  \}" :: forall a. (a -> a -> Number) -> [a] -> [a]

instance functorArray :: Functor [] where
  (<$>) = map

instance applyArray :: Apply [] where
  (<*>) = ap

instance applicativeArray :: Applicative [] where
  pure = singleton

instance bindArray :: Bind [] where
  (>>=) = flip concatMap

instance monadArray :: Monad []

instance semigroupArray :: Semigroup [a] where
  (<>) = append

instance alternativeArray :: Alternative [] where
  empty = []
  (<|>) = append


Got the essentials of the onConnect, onDisconnect, and onMessage set up

module AirConsolePong.ScreenMain where

import Prelude (Unit, discard, bind, pure, unit, (<$>), (<<<), (==), (>=), (&&))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Timer (TIMER)
import AirConsole.Global ( getAirConsoleGlobal, orientationLandscape
                         , onConnect, onMessage, onDisconnect
                         )
import AirConsole.Types (AirConsoleGlobal, DeviceId)
import AirConsole.ActivePlayers (convertDeviceIdToPlayerNumber, getActivePlayerDeviceIds, setActivePlayers)
import AirConsole.Connectivity (getControllerDeviceIds)
import AirConsolePong.Views.FFI (updateCanvasDim, showStuff)
import AirConsolePong.Views.ScreenStart (view , drawGame)
import AirConsolePong.Game.Model (initialGameState)
import AirConsolePong.Game.Update (gameLogic, Input)
import Data.Maybe (Maybe(Just, Nothing))
import Data.Nullable (toMaybe)
import Data.Array (length)
import DOM (DOM)
import Graphics.Canvas (CANVAS, getCanvasElementById)
import Signal (foldp, runSignal, sampleOn)
import Signal.DOM (animationFrame)
import Signal.Channel (channel, send, subscribe, Channel, CHANNEL)

startGame
    :: forall eff
     . Channel Input
    -> Eff ( dom :: DOM
           , timer :: TIMER
           , console :: CONSOLE
           , canvas :: CANVAS | eff
           ) Unit
startGame channel = do
    mcanvas <- getCanvasElementById "game-canvas"
    case mcanvas of
        Just canvas -> do
            _ <- updateCanvasDim canvas
            frames <- animationFrame
            let inputs = subscribe channel
            let game = foldp gameLogic initialGameState (sampleOn frames inputs)
            runSignal (drawGame canvas true <$> game)
            pure unit
        Nothing -> pure unit

handleConnection
    :: forall e
     . AirConsoleGlobal
    -> Channel Input
    -> DeviceId
    -> Eff ( dom :: DOM
           , timer :: TIMER
           , console :: CONSOLE
           , canvas :: CANVAS
           | e ) Unit
handleConnection ac ch d =
    let
        apLength :: Int
        apLength = (length <<< getActivePlayerDeviceIds) ac

        cdLength :: Int
        cdLength = (length <<< getControllerDeviceIds) ac
     in
        if apLength == 0 && cdLength >= 2
           then do
               _ <- setActivePlayers ac 2
               startGame ch
        else if apLength == 0 && cdLength == 1
            then do
               pure unit
        else if apLength == 0 && cdLength == 0
            then do
                pure unit
        else do
            pure unit

handleDisconnect
    :: forall e
     . AirConsoleGlobal
    -> Channel Input
    -> DeviceId
    -> Eff ( dom :: DOM
           , timer :: TIMER
           , console :: CONSOLE
           , canvas :: CANVAS
           | e ) Unit
handleDisconnect ac ch d = do
    mpn <- pure ((toMaybe <<< convertDeviceIdToPlayerNumber ac) d)
    case mpn of
         Just pn -> do
             _ <- setActivePlayers ac 0
             pure unit
         Nothing -> pure unit
    handleConnection ac ch d

handleMessage
    :: forall e a
     . AirConsoleGlobal
    -> Channel Input
    -> DeviceId
    -> { move :: Number | a }
    -> Eff (console :: CONSOLE, channel :: CHANNEL | e) Unit
handleMessage ac ch d x = do
    mpn <- pure ((toMaybe <<< convertDeviceIdToPlayerNumber ac) d)
    case mpn of
         Just pn -> showStuff pn
         Nothing -> log "Nothing"
    send ch { p1: { move: x.move }
            , p2: { move: 0.0 }
            , ball: { x: 0.0, y: 0.0 }
            }

main
    :: forall e
     . Eff ( channel :: CHANNEL
           , dom :: DOM
           , canvas :: CANVAS
           , console :: CONSOLE
           , timer :: TIMER | e
           ) Unit
main = do
    ac <- getAirConsoleGlobal { orientation: orientationLandscape }
    ch <- channel { p1: { move: 0.0 }
                  , p2: { move: 0.0 }
                  , ball: { x: 0.0, y: 0.0 }
                  }
    view ac
    _ <- onConnect (handleConnection ac ch) ac
    _ <- onMessage (handleMessage ac ch) ac
    _ <- onDisconnect (handleDisconnect ac ch) ac
    startGame ch
    log "Running"

module AirConsolePong.ScreenMain where

import Prelude (Unit, discard, bind, pure, unit, (<$>))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Timer (TIMER)
import AirConsole.Global ( getAirConsoleGlobal , orientationLandscape
                         , onConnect , onReady , onMessage , onDisconnect
                         )
import AirConsolePong.Views.FFI (updateCanvasDim)
import AirConsolePong.Views.ScreenStart (view , drawGame)
import AirConsolePong.Game.Model (initialGameState)
import AirConsolePong.Game.Update (gameLogic, Input)
import Data.Maybe (Maybe(Just, Nothing))
import DOM (DOM)
import Graphics.Canvas (CANVAS, getCanvasElementById)
import Signal (foldp, runSignal, sampleOn)
import Signal.DOM (animationFrame)
import Signal.Channel (channel, send, subscribe, Channel, CHANNEL)

startGame
    :: forall eff
     . Channel Input
    -> Eff ( dom :: DOM
           , timer :: TIMER
           , console :: CONSOLE
           , canvas :: CANVAS | eff
           ) Unit
startGame channel = do
    mcanvas <- getCanvasElementById "game-canvas"
    case mcanvas of
        Just canvas -> do
            _ <- updateCanvasDim canvas
            frames <- animationFrame
            let inputs = subscribe channel
            let game = foldp gameLogic initialGameState (sampleOn frames inputs)
            runSignal (drawGame canvas true <$> game)
            pure unit
        Nothing -> pure unit

main
    :: forall e
     . Eff ( channel :: CHANNEL
           , dom :: DOM
           , canvas :: CANVAS
           , console :: CONSOLE
           , timer :: TIMER | e
           ) Unit
main = do
    ac <- getAirConsoleGlobal { orientation: orientationLandscape }
    ch <- channel { p1: { move: 0.0 }
                  , p2: { move: 0.0 }
                  , ball: { x: 0.0, y: 0.0 }
                  }
    view ac
    _ <- onConnect (\d -> log "on Connection") ac
    _ <- onMessage (\d x -> do
                        send ch { p1: { move: x.move }
                                , p2: { move: 0.0 }
                                , ball: { x: 0.0, y: 0.0 }
                                }
                   ) ac
    _ <- onReady (\d -> log "on Ready") ac
    _ <- onDisconnect (\d -> log "on Disconnect") ac
    startGame ch
    log "Running"


add some tests

add some tests

module Test.Main where

import Prelude
import Control.Monad.Eff.Console
import Test.Unit
import Test.Unit.Console hiding (print)
import Data.Array

import KanColle.Expedition
import KanColle.SType

instance eqFleetRequirementForTest :: Eq FleetRequirement where
    eq r1 r2 = explainFleetRequirement r1 == explainFleetRequirement r2

mkShip :: SType -> Int -> Int -> Ship ()
mkShip st l d =
    { ammo: 0
    , morale: 0
    , stype: st
    , level: l
    , drumCount: d }

testFleet1 :: Fleet ()
testFleet1 =
    [ mkShip SS 18 0
    , mkShip SS 59 0
    , mkShip SSV 62 0
    , mkShip SSV 61 0
    ]

testFleet2 :: Fleet ()
testFleet2 =
    [ mkShip DD 31 0
    , mkShip DD 12 0
    , mkShip DD 12 0
    , mkShip DD 14 0
    ]

testFleet3 :: Fleet ()
testFleet3 =
    [ mkShip CL 33 1
    , mkShip DD 13 1
    , mkShip DD 12 1
    , mkShip DD 8 0
    , mkShip DD 14 1
    ]

testFleet4 :: Fleet ()
testFleet4 =
    [ mkShip DD 58 1
    , mkShip DD 31 1
    , mkShip DD 44 1
    , mkShip DD 39 1
    , mkShip DD 36 1
    , mkShip CL 41 1
    ]

type MyTest e = Test (testOutput :: TestOutput | e)

-- cover all possible expeditions
testExpeditionHelper :: forall e. MyTest e
testExpeditionHelper =
  test "ExpeditionHelper: fleet tests" do
    assert "fleet test 1" $
      unsatisfiedRequirements 2 testFleet1 == []
    assert "fleet test 2" $
      getAvailableExpeditions testFleet1 == [1,2,3,6,27]
    assert "fleet test 3" $
      getAvailableExpeditions testFleet2 == [1,2,3,6,11,12]
    assert "fleet test 3" $
      getAvailableExpeditions testFleet3 == [1,2,3,4,5,6,9,11,12,21]
    assert "fleet test 4" $
      getAvailableExpeditions testFleet4 == [1,2,3,4,5,6,7,8,9,11,12,13,14,16,17,21,37]

main = runTest do
    testExpeditionHelper

module Test.Main where

import Prelude
import Control.Monad.Eff.Console
import Test.Unit
import Data.Array

import KanColle.Expedition
import KanColle.SType

instance eqFleetRequirementForTest :: Eq FleetRequirement where
    eq r1 r2 = explainFleetRequirement r1 == explainFleetRequirement r2

mkShip :: SType -> Int -> Int -> Ship ()
mkShip st l d =
    { ammo: 0
    , morale: 0
    , stype: st
    , level: l
    , drumCount: d }

testFleet1 :: Fleet ()
testFleet1 =
    [ mkShip SS 18 0
    , mkShip SS 59 0
    , mkShip SSV 62 0
    , mkShip SSV 61 0
    ]

testFleet2 :: Fleet ()
testFleet2 =
    [ mkShip DD 31 0
    , mkShip DD 12 0
    , mkShip DD 12 0
    , mkShip DD 14 0
    ]

testFleet3 :: Fleet ()
testFleet3 =
    [ mkShip CL 33 1
    , mkShip DD 13 1
    , mkShip DD 12 1
    , mkShip DD 8 0
    , mkShip DD 14 1
    ]

testFleet4 :: Fleet ()
testFleet4 =
    [ mkShip DD 58 1
    , mkShip DD 31 1
    , mkShip DD 44 1
    , mkShip DD 39 1
    , mkShip DD 36 1
    , mkShip CL 41 1
    ]

main = runTest do
  test "simple fleet tests" do
    assert "fleet test 1" $
      unsatisfiedRequirements 2 testFleet1 == []
    assert "fleet test 2" $
      getAvailableExpeditions testFleet1 == [1,2,3,6,27]
    assert "fleet test 3" $
      getAvailableExpeditions testFleet2 == [1,2,3,6,11,12]
    assert "fleet test 3" $
      getAvailableExpeditions testFleet3 == [1,2,3,4,5,6,9,11,12,21]
    assert "fleet test 4" $
      getAvailableExpeditions testFleet4 == [1,2,3,4,5,6,7,8,9,11,12,13,14,16,17,21,37]