{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}

module Web.Rep.Examples
  ( page1,
    page2,
    cfg2,
    RepExamples (..),
    repExamples,
    Shape (..),
    fromShape,
    toShape,
    SumTypeExample (..),
    repSumTypeExample,
    SumType2Example (..),
    repSumType2Example,
    listExample,
    listRepExample,
    fiddleExample,
  )
where

import qualified Clay
import Data.Attoparsec.Text
import Data.Biapplicative
import Data.Bool
import Data.Text (Text, pack)
import GHC.Generics
import Lucid
import Optics.Core
import Text.InterpolatedString.Perl6
import Web.Rep

-- | simple page example
page1 :: Page
page1 :: Page
page1 =
  #htmlBody .~ button1 $
    #cssBody .~ RepCss css1 $
      #jsGlobal .~ mempty $
        #jsOnLoad .~ click $
          #libsCss .~ (libCss <$> cssLibs) $
            #libsJs .~ (libJs <$> jsLibs) $
              mempty

-- | page with localised libraries
page2 :: Page
page2 :: Page
page2 =
  #libsCss .~ (libCss <$> cssLibsLocal) $
    #libsJs .~ (libJs <$> jsLibsLocal) $
      page1

cfg2 :: PageConfig
cfg2 :: PageConfig
cfg2 =
  #concerns .~ Separated $
    #pageRender .~ Pretty $
      #structure .~ Headless $
        #localdirs .~ ["test/static"] $
          #filenames .~ (("other/cfg2" <>) <$> suffixes) $
            defaultPageConfig ""

cssLibs :: [Text]
cssLibs :: [Text]
cssLibs =
  [Text
"http://maxcdn.bootstrapcdn.com/font-awesome/4.3.0/css/font-awesome.min.css"]

cssLibsLocal :: [Text]
cssLibsLocal :: [Text]
cssLibsLocal = [Text
"css/font-awesome.min.css"]

jsLibs :: [Text]
jsLibs :: [Text]
jsLibs = [Text
"http://code.jquery.com/jquery-1.6.3.min.js"]

jsLibsLocal :: [Text]
jsLibsLocal :: [Text]
jsLibsLocal = [Text
"jquery-2.1.3.min.js"]

css1 :: Css
css1 :: Css
css1 = do
  forall a. Size a -> Css
Clay.fontSize (Double -> Size LengthUnit
Clay.px Double
10)
  [Text] -> [GenericFontFamily] -> Css
Clay.fontFamily [Text
"Arial", Text
"Helvetica"] [GenericFontFamily
Clay.sansSerif]
  Selector
"#btnGo" Selector -> Css -> Css
Clay.? do
    forall a. Size a -> Css
Clay.marginTop (Double -> Size LengthUnit
Clay.px Double
20)
    forall a. Size a -> Css
Clay.marginBottom (Double -> Size LengthUnit
Clay.px Double
20)
  Selector
"#btnGo.on" Selector -> Css -> Css
Clay.? Color -> Css
Clay.color Color
Clay.green

-- js
click :: RepJs
click :: RepJs
click =
  Text -> RepJs
RepJsText
    [q|
$('#btnGo').click( function() {
  $('#btnGo').toggleClass('on');
  alert('bada bing!');
});
|]

button1 :: Html ()
button1 :: HtmlT Identity ()
button1 =
  forall a. With a => a -> [Attribute] -> a
with
    forall arg result. Term arg result => arg -> result
button_
    [Text -> Attribute
id_ Text
"btnGo", Text -> Attribute
Lucid.type_ Text
"button"]
    (HtmlT Identity ()
"Go " forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
i_ [Text -> Attribute
class__ Text
"fa fa-play"] forall a. Monoid a => a
mempty)

-- | One of each sharedrep input instances.
data RepExamples = RepExamples
  { RepExamples -> Text
repTextbox :: Text,
    RepExamples -> Text
repTextarea :: Text,
    RepExamples -> Int
repSliderI :: Int,
    RepExamples -> Double
repSlider :: Double,
    RepExamples -> Int
repSliderVI :: Int,
    RepExamples -> Double
repSliderV :: Double,
    RepExamples -> Bool
repCheckbox :: Bool,
    RepExamples -> Bool
repToggle :: Bool,
    RepExamples -> Int
repDropdown :: Int,
    RepExamples -> [Int]
repDropdownMultiple :: [Int],
    RepExamples -> Shape
repShape :: Shape,
    RepExamples -> Text
repColor :: Text
  }
  deriving (Int -> RepExamples -> FilePath -> FilePath
[RepExamples] -> FilePath -> FilePath
RepExamples -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [RepExamples] -> FilePath -> FilePath
$cshowList :: [RepExamples] -> FilePath -> FilePath
show :: RepExamples -> FilePath
$cshow :: RepExamples -> FilePath
showsPrec :: Int -> RepExamples -> FilePath -> FilePath
$cshowsPrec :: Int -> RepExamples -> FilePath -> FilePath
Show, RepExamples -> RepExamples -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepExamples -> RepExamples -> Bool
$c/= :: RepExamples -> RepExamples -> Bool
== :: RepExamples -> RepExamples -> Bool
$c== :: RepExamples -> RepExamples -> Bool
Eq, forall x. Rep RepExamples x -> RepExamples
forall x. RepExamples -> Rep RepExamples x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepExamples x -> RepExamples
$cfrom :: forall x. RepExamples -> Rep RepExamples x
Generic)

-- | For a typed dropdown example.
data Shape = SquareShape | CircleShape deriving (Shape -> Shape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq, Int -> Shape -> FilePath -> FilePath
[Shape] -> FilePath -> FilePath
Shape -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Shape] -> FilePath -> FilePath
$cshowList :: [Shape] -> FilePath -> FilePath
show :: Shape -> FilePath
$cshow :: Shape -> FilePath
showsPrec :: Int -> Shape -> FilePath -> FilePath
$cshowsPrec :: Int -> Shape -> FilePath -> FilePath
Show, forall x. Rep Shape x -> Shape
forall x. Shape -> Rep Shape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Shape x -> Shape
$cfrom :: forall x. Shape -> Rep Shape x
Generic)

-- | shape parser
toShape :: Text -> Shape
toShape :: Text -> Shape
toShape Text
t = case Text
t of
  Text
"Circle" -> Shape
CircleShape
  Text
"Square" -> Shape
SquareShape
  Text
_ -> Shape
CircleShape

-- | shape printer
fromShape :: Shape -> Text
fromShape :: Shape -> Text
fromShape Shape
CircleShape = Text
"Circle"
fromShape Shape
SquareShape = Text
"Square"

-- | one of each input SharedReps
repExamples :: (Monad m) => SharedRep m RepExamples
repExamples :: forall (m :: * -> *). Monad m => SharedRep m RepExamples
repExamples = do
  Text
t <- forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
textbox (forall a. a -> Maybe a
Just Text
"textbox") Text
"sometext"
  Text
ta <- forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
3 (forall a. a -> Maybe a
Just Text
"textarea") Text
"no initial value & multi-line text\\nrenders is not ok?/"
  Int
n <- forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI (forall a. a -> Maybe a
Just Text
"int slider") Int
0 Int
5 Int
1 Int
3
  Double
ds' <- forall (m :: * -> *).
Monad m =>
Maybe Text
-> Double -> Double -> Double -> Double -> SharedRep m Double
slider (forall a. a -> Maybe a
Just Text
"double slider") Double
0 Double
1 Double
0.1 Double
0.5
  Int
nV <- forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderVI (forall a. a -> Maybe a
Just Text
"int slider") Int
0 Int
5 Int
1 Int
3
  Double
dsV' <- forall (m :: * -> *).
Monad m =>
Maybe Text
-> Double -> Double -> Double -> Double -> SharedRep m Double
sliderV (forall a. a -> Maybe a
Just Text
"double slider") Double
0 Double
1 Double
0.1 Double
0.5
  Bool
c <- forall (m :: * -> *).
Monad m =>
Maybe Text -> Bool -> SharedRep m Bool
checkbox (forall a. a -> Maybe a
Just Text
"checkbox") Bool
True
  Bool
tog <- forall (m :: * -> *).
Monad m =>
Maybe Text -> Bool -> SharedRep m Bool
toggle (forall a. a -> Maybe a
Just Text
"toggle") Bool
False
  Int
dr <- forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdown forall a. Integral a => Parser a
decimal (FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) (forall a. a -> Maybe a
Just Text
"dropdown") (FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
5 :: Int]) Int
3
  [Int]
drm <- forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> [a] -> SharedRep m [a]
dropdownMultiple forall a. Integral a => Parser a
decimal (FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) (forall a. a -> Maybe a
Just Text
"dropdown multiple") (FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
5 :: Int]) [Int
2, Int
4]
  Shape
drt <- Text -> Shape
toShape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdown Parser Text
takeText forall a. a -> a
id (forall a. a -> Maybe a
Just Text
"shape") [Text
"Circle", Text
"Square"] (Shape -> Text
fromShape Shape
SquareShape)
  Text
col <- forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
colorPicker (forall a. a -> Maybe a
Just Text
"color") Text
"#454e56"
  pure (Text
-> Text
-> Int
-> Double
-> Int
-> Double
-> Bool
-> Bool
-> Int
-> [Int]
-> Shape
-> Text
-> RepExamples
RepExamples Text
t Text
ta Int
n Double
ds' Int
nV Double
dsV' Bool
c Bool
tog Int
dr [Int]
drm Shape
drt Text
col)

listExample :: (Monad m) => Int -> SharedRep m [Int]
listExample :: forall (m :: * -> *). Monad m => Int -> SharedRep m [Int]
listExample Int
n =
  forall (m :: * -> *) a.
Monad m =>
Maybe Text
-> Text
-> Maybe Text
-> (Text -> a -> SharedRep m a)
-> [Text]
-> [a]
-> SharedRep m [a]
accordionList
    (forall a. a -> Maybe a
Just Text
"accordianListify")
    Text
"al"
    forall a. Maybe a
Nothing
    (\Text
l Int
a -> forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI (forall a. a -> Maybe a
Just Text
l) (Int
0 :: Int) Int
n Int
1 Int
a)
    ((\Int
x -> Text
"[" forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Int
x forall a. Semigroup a => a -> a -> a
<> Text
"]") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
n] :: [Text])
    [Int
0 .. Int
n]

listRepExample :: (Monad m) => Int -> SharedRep m [Int]
listRepExample :: forall (m :: * -> *). Monad m => Int -> SharedRep m [Int]
listRepExample Int
n =
  forall (m :: * -> *) a.
Monad m =>
Maybe Text
-> Text
-> (Bool -> SharedRep m Bool)
-> (a -> SharedRep m a)
-> Int
-> a
-> [a]
-> SharedRep m [a]
listRep
    (forall a. a -> Maybe a
Just Text
"listifyMaybe")
    Text
"alm"
    (forall (m :: * -> *).
Monad m =>
Maybe Text -> Bool -> SharedRep m Bool
checkbox forall a. Maybe a
Nothing)
    (forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI forall a. Maybe a
Nothing (Int
0 :: Int) Int
n Int
1)
    Int
n
    Int
3
    [Int
0 .. Int
4]

fiddleExample :: Concerns Text
fiddleExample :: Concerns Text
fiddleExample =
  forall a. a -> a -> a -> Concerns a
Concerns
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    [q|
<div class=" form-group-sm "><label for="1">fiddle example</label><input max="10.0" value="3.0" oninput="jsb.event({ &#39;element&#39;: this.id, &#39;value&#39;: this.value});" step="1.0" min="0.0" id="1" type="range" class=" custom-range  form-control-range "></div>
|]

data SumTypeExample = SumInt Int | SumOnly | SumText Text deriving (SumTypeExample -> SumTypeExample -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumTypeExample -> SumTypeExample -> Bool
$c/= :: SumTypeExample -> SumTypeExample -> Bool
== :: SumTypeExample -> SumTypeExample -> Bool
$c== :: SumTypeExample -> SumTypeExample -> Bool
Eq, Int -> SumTypeExample -> FilePath -> FilePath
[SumTypeExample] -> FilePath -> FilePath
SumTypeExample -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SumTypeExample] -> FilePath -> FilePath
$cshowList :: [SumTypeExample] -> FilePath -> FilePath
show :: SumTypeExample -> FilePath
$cshow :: SumTypeExample -> FilePath
showsPrec :: Int -> SumTypeExample -> FilePath -> FilePath
$cshowsPrec :: Int -> SumTypeExample -> FilePath -> FilePath
Show, forall x. Rep SumTypeExample x -> SumTypeExample
forall x. SumTypeExample -> Rep SumTypeExample x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SumTypeExample x -> SumTypeExample
$cfrom :: forall x. SumTypeExample -> Rep SumTypeExample x
Generic)

sumTypeText :: SumTypeExample -> Text
sumTypeText :: SumTypeExample -> Text
sumTypeText (SumInt Int
_) = Text
"SumInt"
sumTypeText SumTypeExample
SumOnly = Text
"SumOnly"
sumTypeText (SumText Text
_) = Text
"SumText"

repSumTypeExample :: (Monad m) => Int -> Text -> SumTypeExample -> SharedRep m SumTypeExample
repSumTypeExample :: forall (m :: * -> *).
Monad m =>
Int -> Text -> SumTypeExample -> SharedRep m SumTypeExample
repSumTypeExample Int
defi Text
deft SumTypeExample
defst =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall {arg} {result}.
(Term arg result, Semigroup arg, With arg) =>
arg -> arg -> arg -> result
hmap forall {a}.
(Eq a, IsString a) =>
a -> Int -> Text -> SumTypeExample
mmap SharedRep m Text
repst forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRep m Int
repi forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRep m Text
rept
  where
    repi :: SharedRep m Int
repi = forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI forall a. Maybe a
Nothing Int
0 Int
20 Int
1 Int
defInt
    rept :: SharedRep m Text
rept = forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
textbox forall a. Maybe a
Nothing Text
defText
    repst :: SharedRep m Text
repst =
      forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdownSum
        Parser Text
takeText
        forall a. a -> a
id
        (forall a. a -> Maybe a
Just Text
"SumTypeExample")
        [Text
"SumInt", Text
"SumOnly", Text
"SumText"]
        (SumTypeExample -> Text
sumTypeText SumTypeExample
defst)
    hmap :: arg -> arg -> arg -> result
hmap arg
repst' arg
repi' arg
rept' =
      forall arg result. Term arg result => arg -> result
div_
        ( arg
repst'
            forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
              arg
repi'
              [ Text -> Attribute
class__ Text
"subtype ",
                Text -> Text -> Attribute
data_ Text
"sumtype" Text
"SumInt",
                forall arg result. TermRaw arg result => arg -> result
style_
                  ( Text
"display:"
                      forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"block" Text
"none" (SumTypeExample -> Text
sumTypeText SumTypeExample
defst forall a. Eq a => a -> a -> Bool
/= Text
"SumInt")
                  )
              ]
            forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
              arg
rept'
              [ Text -> Attribute
class__ Text
"subtype ",
                Text -> Text -> Attribute
data_ Text
"sumtype" Text
"SumText",
                forall arg result. TermRaw arg result => arg -> result
style_
                  (Text
"display:" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"block" Text
"none" (SumTypeExample -> Text
sumTypeText SumTypeExample
defst forall a. Eq a => a -> a -> Bool
/= Text
"SumText"))
              ]
        )
    mmap :: a -> Int -> Text -> SumTypeExample
mmap a
repst' Int
repi' Text
rept' =
      case a
repst' of
        a
"SumInt" -> Int -> SumTypeExample
SumInt Int
repi'
        a
"SumOnly" -> SumTypeExample
SumOnly
        a
"SumText" -> Text -> SumTypeExample
SumText Text
rept'
        a
_ -> SumTypeExample
SumOnly
    defInt :: Int
defInt = case SumTypeExample
defst of
      SumInt Int
i -> Int
i
      SumTypeExample
_NotSumInt -> Int
defi
    defText :: Text
defText = case SumTypeExample
defst of
      SumText Text
t -> Text
t
      SumTypeExample
_NotSumText -> Text
deft

data SumType2Example = SumOutside Int | SumInside SumTypeExample deriving (SumType2Example -> SumType2Example -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumType2Example -> SumType2Example -> Bool
$c/= :: SumType2Example -> SumType2Example -> Bool
== :: SumType2Example -> SumType2Example -> Bool
$c== :: SumType2Example -> SumType2Example -> Bool
Eq, Int -> SumType2Example -> FilePath -> FilePath
[SumType2Example] -> FilePath -> FilePath
SumType2Example -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SumType2Example] -> FilePath -> FilePath
$cshowList :: [SumType2Example] -> FilePath -> FilePath
show :: SumType2Example -> FilePath
$cshow :: SumType2Example -> FilePath
showsPrec :: Int -> SumType2Example -> FilePath -> FilePath
$cshowsPrec :: Int -> SumType2Example -> FilePath -> FilePath
Show, forall x. Rep SumType2Example x -> SumType2Example
forall x. SumType2Example -> Rep SumType2Example x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SumType2Example x -> SumType2Example
$cfrom :: forall x. SumType2Example -> Rep SumType2Example x
Generic)

sumType2Text :: SumType2Example -> Text
sumType2Text :: SumType2Example -> Text
sumType2Text (SumOutside Int
_) = Text
"SumOutside"
sumType2Text (SumInside SumTypeExample
_) = Text
"SumInside"

repSumType2Example :: (Monad m) => Int -> Text -> SumTypeExample -> SumType2Example -> SharedRep m SumType2Example
repSumType2Example :: forall (m :: * -> *).
Monad m =>
Int
-> Text
-> SumTypeExample
-> SumType2Example
-> SharedRep m SumType2Example
repSumType2Example Int
defi Text
deft SumTypeExample
defst SumType2Example
defst2 =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall {arg} {result}.
(Term arg result, Semigroup arg, With arg) =>
arg -> arg -> arg -> result
hmap forall {a}.
(Eq a, IsString a) =>
a -> SumTypeExample -> Int -> SumType2Example
mmap SharedRep m Text
repst2 forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRep m SumTypeExample
repst forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRep m Int
repoi
  where
    repoi :: SharedRep m Int
repoi = forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI forall a. Maybe a
Nothing Int
0 Int
20 Int
1 Int
defInt
    repst :: SharedRep m SumTypeExample
repst = forall (m :: * -> *).
Monad m =>
Int -> Text -> SumTypeExample -> SharedRep m SumTypeExample
repSumTypeExample Int
defi Text
deft SumTypeExample
SumOnly
    repst2 :: SharedRep m Text
repst2 =
      forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdownSum
        Parser Text
takeText
        forall a. a -> a
id
        (forall a. a -> Maybe a
Just Text
"SumType2Example")
        [Text
"SumOutside", Text
"SumInside"]
        (SumType2Example -> Text
sumType2Text SumType2Example
defst2)
    hmap :: arg -> arg -> arg -> result
hmap arg
repst2' arg
repst' arg
repoi' =
      forall arg result. Term arg result => arg -> result
div_
        ( arg
repst2'
            forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
              arg
repst'
              [ Text -> Attribute
class__ Text
"subtype ",
                Text -> Text -> Attribute
data_ Text
"sumtype" Text
"SumInside",
                forall arg result. TermRaw arg result => arg -> result
style_
                  ( Text
"display:"
                      forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"block" Text
"none" (SumType2Example -> Text
sumType2Text SumType2Example
defst2 forall a. Eq a => a -> a -> Bool
/= Text
"SumInside")
                  )
              ]
            forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
              arg
repoi'
              [ Text -> Attribute
class__ Text
"subtype ",
                Text -> Text -> Attribute
data_ Text
"sumtype" Text
"SumOutside",
                forall arg result. TermRaw arg result => arg -> result
style_
                  ( Text
"display:"
                      forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"block" Text
"none" (SumType2Example -> Text
sumType2Text SumType2Example
defst2 forall a. Eq a => a -> a -> Bool
/= Text
"SumOutside")
                  )
              ]
        )
    mmap :: a -> SumTypeExample -> Int -> SumType2Example
mmap a
repst2' SumTypeExample
repst' Int
repoi' =
      case a
repst2' of
        a
"SumOutside" -> Int -> SumType2Example
SumOutside Int
repoi'
        a
"SumInside" -> SumTypeExample -> SumType2Example
SumInside SumTypeExample
repst'
        a
_WeirdSpelling -> Int -> SumType2Example
SumOutside Int
repoi'
    defInt :: Int
defInt = case SumTypeExample
defst of
      SumInt Int
i -> Int
i
      SumTypeExample
_NotSumInt -> Int
defi