{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | Some simple usage examples to get started with the library.
--
-- The most important example is 'repExamples' which forms the basis of the app example.
module Web.Rep.Examples
  ( page1,
    page2,
    cfg2,
    RepExamples (..),
    repExamples,
    Shape (..),
    fromShape,
    toShape,
  )
where

import Data.ByteString (ByteString)
import Data.String.Interpolate
import FlatParse.Basic (takeRest)
import GHC.Generics
import MarkupParse
import MarkupParse.FlatParse
import Optics.Core hiding (element)
import Web.Rep

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

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

-- | Page with separated css and js.
cfg2 :: PageConfig
cfg2 :: PageConfig
cfg2 =
  #concerns .~ Separated $
    #renderStyle .~ Indented 4 $
      #structure .~ Headless $
        #localdirs .~ ["test/static"] $
          #filenames .~ (("other/cfg2" <>) <$> suffixes) $
            defaultPageConfig ""

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

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

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

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

css1 :: Css
css1 :: Css
css1 =
  ByteString -> Css
Css
    [i|
{
  font-size   : 10px;
  font-family : "Arial","Helvetica", sans-serif;
}

\#btnGo
{
  margin-top    : 20px;
  margin-bottom : 20px;
}

\#btnGo.on
{
  color : \#008000;
}
|]

-- js
click :: Js
click :: Js
click =
  ByteString -> Js
Js
    [i|
$('\#btnGo').click( function() {
  $('\#btnGo').toggleClass('on');
  alert('bada bing!');
});
|]

button1 :: Markup
button1 :: Markup
button1 =
  ByteString -> [Attr] -> Markup -> Markup
element
    ByteString
"button"
    [ ByteString -> ByteString -> Attr
Attr ByteString
"id" ByteString
"btnGo",
      ByteString -> ByteString -> Attr
Attr ByteString
"type" ByteString
"button"
    ]
    (ByteString -> Markup
content ByteString
"Go" forall a. Semigroup a => a -> a -> a
<> ByteString -> [Attr] -> Markup
element_ ByteString
"i" [ByteString -> ByteString -> Attr
Attr ByteString
"class" ByteString
"fa fa-play"])

-- | One of each sharedrep input instances.
data RepExamples = RepExamples
  { RepExamples -> ByteString
repTextbox :: ByteString,
    RepExamples -> ByteString
repTextarea :: ByteString,
    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 -> ByteString
repColor :: ByteString
  }
  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 :: ByteString -> Shape
toShape :: ByteString -> Shape
toShape ByteString
t = case ByteString
t of
  ByteString
"Circle" -> Shape
CircleShape
  ByteString
"Square" -> Shape
SquareShape
  ByteString
_ -> Shape
CircleShape

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

-- | one of each input SharedReps
repExamples :: (Monad m) => SharedRep m RepExamples
repExamples :: forall (m :: * -> *). Monad m => SharedRep m RepExamples
repExamples = do
  ByteString
t <- forall (m :: * -> *).
Monad m =>
Maybe ByteString -> ByteString -> SharedRep m ByteString
textbox (forall a. a -> Maybe a
Just ByteString
"textbox") ByteString
"sometext"
  ByteString
ta <- forall (m :: * -> *).
Monad m =>
Int -> Maybe ByteString -> ByteString -> SharedRep m ByteString
textarea Int
3 (forall a. a -> Maybe a
Just ByteString
"textarea") ByteString
"no initial value & multi-line text"
  Int
n <- forall (m :: * -> *) a.
(Monad m, Integral a, ToByteString a) =>
Maybe ByteString -> a -> a -> a -> a -> SharedRep m a
sliderI (forall a. a -> Maybe a
Just ByteString
"int slider") Int
0 Int
5 Int
1 Int
3
  Double
ds' <- forall (m :: * -> *).
Monad m =>
Maybe ByteString
-> Double -> Double -> Double -> Double -> SharedRep m Double
slider (forall a. a -> Maybe a
Just ByteString
"double slider") Double
0 Double
1 Double
0.1 Double
0.5
  Int
nV <- forall (m :: * -> *) a.
(Monad m, Integral a, ToByteString a) =>
Maybe ByteString -> a -> a -> a -> a -> SharedRep m a
sliderVI (forall a. a -> Maybe a
Just ByteString
"int slider") Int
0 Int
5 Int
1 Int
3
  Double
dsV' <- forall (m :: * -> *).
Monad m =>
Maybe ByteString
-> Double -> Double -> Double -> Double -> SharedRep m Double
sliderV (forall a. a -> Maybe a
Just ByteString
"double slider") Double
0 Double
1 Double
0.1 Double
0.5
  Bool
c <- forall (m :: * -> *).
Monad m =>
Maybe ByteString -> Bool -> SharedRep m Bool
checkbox (forall a. a -> Maybe a
Just ByteString
"checkbox") Bool
True
  Bool
tog <- forall (m :: * -> *).
Monad m =>
Maybe ByteString -> Bool -> SharedRep m Bool
toggle (forall a. a -> Maybe a
Just ByteString
"toggle") Bool
False
  Int
dr <- forall (m :: * -> *) a.
Monad m =>
(ByteString -> Either ByteString a)
-> (a -> ByteString)
-> Maybe ByteString
-> [ByteString]
-> a
-> SharedRep m a
dropdown (forall e a. IsString e => Parser e a -> ByteString -> Either e a
runParserEither forall e. Parser e Int
int) (FilePath -> ByteString
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) (forall a. a -> Maybe a
Just ByteString
"dropdown") (FilePath -> ByteString
strToUtf8 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 =>
Parser ByteString a
-> (a -> ByteString)
-> Maybe ByteString
-> [ByteString]
-> [a]
-> SharedRep m [a]
dropdownMultiple forall e. Parser e Int
int (FilePath -> ByteString
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) (forall a. a -> Maybe a
Just ByteString
"dropdown multiple") (FilePath -> ByteString
strToUtf8 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 <- ByteString -> Shape
toShape forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
(ByteString -> Either ByteString a)
-> (a -> ByteString)
-> Maybe ByteString
-> [ByteString]
-> a
-> SharedRep m a
dropdown (forall e a. IsString e => Parser e a -> ByteString -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e ByteString
takeRest) forall a. a -> a
id (forall a. a -> Maybe a
Just ByteString
"shape") [ByteString
"Circle", ByteString
"Square"] (Shape -> ByteString
fromShape Shape
SquareShape)
  ByteString
col <- forall (m :: * -> *).
Monad m =>
Maybe ByteString -> ByteString -> SharedRep m ByteString
colorPicker (forall a. a -> Maybe a
Just ByteString
"color") ByteString
"#454e56"
  pure (ByteString
-> ByteString
-> Int
-> Double
-> Int
-> Double
-> Bool
-> Bool
-> Int
-> [Int]
-> Shape
-> ByteString
-> RepExamples
RepExamples ByteString
t ByteString
ta Int
n Double
ds' Int
nV Double
dsV' Bool
c Bool
tog Int
dr [Int]
drm Shape
drt ByteString
col)