Variant Eunm from ADT

Main.purs

module Main where

import Prelude

import Data.Enum (upFrom)
import Data.Foldable (fold)
import Data.Generic.Rep (Constructor, Sum) as Generic.Rep
import Data.Generic.Rep (class Generic)
import Data.List (List)
import Data.Map (fromFoldable, lookup) as Map
import Data.Maybe (Maybe)
import Data.Symbol (class IsSymbol)
import Data.Tuple.Nested ((/\))
import Data.Variant (Unvariant(..), Variant, unvariant)
import Data.Variant (class VariantBoundedEnums, class VariantEqs, class VariantOrds, Variant)
import Data.Variant.Internal (class VariantTags)
import Effect (Effect)
import Effect.Console (log)
import Prim.Row (class Cons, class Union) as Row
import Prim.RowList (class RowToList)
import Type.Prelude (reflectSymbol)

import TryPureScript (h1, h2, p, text, list, indent, link, render, code)

type NumericRange = { from :: Number, to :: Number }

data AttributoType
  = AttributoTypeInt
  | AttributoTypeDuration
  | AttributoTypeDateTime
  | AttributoTypeSample
  | AttributoTypeString
  | AttributoTypeComments
  | AttributoTypeList { subType :: AttributoType, minLength :: Maybe Int, maxLength :: Maybe Int }
  | AttributoTypeNumber { range :: Maybe NumericRange, suffix :: Maybe String, standardUnit :: Boolean }
  | AttributoTypeChoice { values :: Array String }

derive instance Generic AttributoType _

class ToLabelRow :: Type -> Row Type -> Constraint
class ToLabelRow t rl | t -> rl

instance (IsSymbol name, Row.Cons name Unit () r) => ToLabelRow (Generic.Rep.Constructor name args) r
instance (ToLabelRow l lr, ToLabelRow r rr, Row.Union lr rr res) => ToLabelRow (Generic.Rep.Sum l r) res

-- | I'm not sure but there is probably no "alias" for all these constraints
-- | required by `Enum` instance for `Variant`
choices :: forall g r rl
  . Generic AttributoType g
  => ToLabelRow g r
  => RowToList r rl
  => VariantBoundedEnums rl
  => VariantTags rl
  => VariantEqs rl
  => VariantOrds rl
  => List (Variant r)
choices = upFrom (bottom :: Variant r)

-- | This helper is not provided by the variant lib I think...
tag ∷ ∀ v. Variant v → String
tag v = do
  let
    Unvariant c = unvariant v
  c \s _ → reflectSymbol s

parse = do
  let
    label2value = Map.fromFoldable $ map (\v -> tag v /\ v) choices
  flip Map.lookup label2value

main :: Effect Unit
main =
  render $ fold
    [ p (text $ "map tag choices = " <> (show $ map tag choices))
    , p (text $ "isJust <<< parse $ \"AttributoTypeSample\" = " <> (show $ parse "AttributoTypeSample")) 
    ]