ConfigFormContainer.purs 4.82 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
module Gargantext.Components.PhyloExplorer.ConfigFormParser
  ( useConfigFormParser
  ) where

import Gargantext.Prelude

import Data.Either (Either(..))
import Data.Int as Int
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.Number as Number
import Gargantext.Components.PhyloExplorer.API (Clique(..), CliqueFilter, ReflexiveClique(..), ReflexiveTimeUnit, TimeUnitCriteria(..), UpdateData(..), extractCriteria, fromReflexiveTimeUnit, toReflexiveTimeUnit)
13
import Gargantext.Components.PhyloExplorer.Config.ConfigForm (FormData)
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils (getter)
import Reactix as R
import Record (merge)
import Unsafe.Coerce (unsafeCoerce)

type Methods =
  -- | Parse `PhyloExplorer.API.UpdateData` to hydrate optional properties of
  -- | `ConfigForm.FormData`
  -- |
  -- | (!) I/O as `UpdateData` type can be changed to anything, it has been
  -- |     chosen this way for simplification (KISS choice: API ⟷ FormData)
  ( toFormData    :: UpdateData      -> Record ()
  -- | Parse callback returned data from `ConfigForm.FormData` into the
  -- | `PhyloExplorer.API.UpdateData`
  , fromFormData  :: Record FormData -> Either FrontendError UpdateData
  )

useConfigFormParser :: R.Hooks (Record Methods)
useConfigFormParser = do

  let
    castError ::
         Either String        UpdateData
      -> Either FrontendError UpdateData
    castError (Left error) = Left $ FOtherError { error }
    castError (Right a)    = pure a

  pure
    { toFormData
    , fromFormData: (_ # fromFormData) >>> castError
    }


toFormData :: UpdateData -> Record ()
toFormData nt =
  let r = unwrap nt
  in unsafeCoerce $
52 53
    { defaultMode : show r.defaultMode
    , proximity:
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
        show r.proximity
    , synchrony:
        show r.synchrony
    , quality:
        show r.quality
    , exportFilter:
        show r.exportFilter
    -- Time unit
    , granularity: r #
        (show <<< toReflexiveTimeUnit <<< _.timeUnit)
    , period: r #
        (show <<< getter _.period <<< extractCriteria <<< _.timeUnit)
    , step: r #
        (show <<< getter _.step <<< extractCriteria <<< _.timeUnit)
    , matchingFrame: r #
        (show <<< getter _.matchingFrame <<< extractCriteria <<< _.timeUnit)
    -- Clique
    } `merge` parseClique r.clique
  where
    parseClique :: Clique -> Record ()
    parseClique (FIS o) = unsafeCoerce $
      { support     : show o.support
      , size        : show o.size
      , cliqueType  : show FIS_
      }
    parseClique (MaxClique o) = unsafeCoerce $
      { size        : show o.size
      , threshold   : show o.threshold
      , cliqueFilter: show o.filter
      , cliqueType  : show MaxClique_
      }

fromFormData :: Record FormData -> Either String UpdateData
fromFormData r = do
  -- Common params
89 90 91
  defaultMode <-
    read r.defaultMode `orDie` "Invalid defaultMode"

92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
  proximity <-
    Number.fromString r.proximity `orDie` "Invalid proximity"
  synchrony <-
    Number.fromString r.synchrony `orDie` "Invalid synchrony"
  quality <-
    Number.fromString r.quality `orDie` "Invalid quality"
  exportFilter <-
    Number.fromString r.exportFilter `orDie` "Invalid exportFilter"

  -- Time unit params
  (granularity :: ReflexiveTimeUnit) <-
    read r.granularity `orDie` "Invalid granularity"
  period <-
    Int.fromString r.period `orDie` "Invalid period"
  step <-
    Int.fromString r.step `orDie` "Invalid step"
  matchingFrame <-
    Int.fromString r.matchingFrame `orDie` "Invalid matchingFrame"

  criteria <- pure $
    parseCriteria period step matchingFrame
  timeUnit <- pure $
    fromReflexiveTimeUnit granularity criteria

  -- Clique params
  (cliqueType :: ReflexiveClique) <-
    read r.cliqueType `orDie` "Invalid cliqueType"

  clique <-
    parseClique r cliqueType

  -- Constructor
  pure $ UpdateData
125 126
    { defaultMode
    , proximity
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
    , synchrony
    , quality
    , exportFilter
    , timeUnit
    , clique
    }
  where
    parseCriteria :: Int -> Int -> Int -> TimeUnitCriteria
    parseCriteria period step matchingFrame = TimeUnitCriteria
      { period
      , step
      , matchingFrame
      }

    parseClique ::
         Record FormData
      -> ReflexiveClique
      -> Either String Clique
    parseClique o = case _ of
      FIS_ -> ado
        support <-
          Int.fromString o.support `orDie` "Invalid support"
        size <-
          Int.fromString o.size `orDie` "Invalid size"
        in
          FIS { support, size }
      MaxClique_ -> ado
        size <-
          Int.fromString o.size `orDie` "Invalid size"
        threshold <-
          Number.fromString o.threshold `orDie` "Invalid threshold"
        (filter :: CliqueFilter) <-
          read o.cliqueFilter `orDie` "Invalid cliqueFilter"
        in
          MaxClique { size, threshold, filter }

orDie :: forall err a. Maybe a -> err -> Either err a
orDie (Just a) _   = pure a
orDie Nothing  err = Left err