{-# LANGUAGE TemplateHaskell #-}

module BtcLsp.Yesod.Data.Widget where

import BtcLsp.Yesod.Import
import GHC.Exts (IsList (..))
import Yesod.Form.Bootstrap3

newtype HtmlClassAttr
  = HtmlClassAttr [Text]
  deriving newtype
    ( HtmlClassAttr -> HtmlClassAttr -> Bool
(HtmlClassAttr -> HtmlClassAttr -> Bool)
-> (HtmlClassAttr -> HtmlClassAttr -> Bool) -> Eq HtmlClassAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HtmlClassAttr -> HtmlClassAttr -> Bool
$c/= :: HtmlClassAttr -> HtmlClassAttr -> Bool
== :: HtmlClassAttr -> HtmlClassAttr -> Bool
$c== :: HtmlClassAttr -> HtmlClassAttr -> Bool
Eq,
      Eq HtmlClassAttr
Eq HtmlClassAttr
-> (HtmlClassAttr -> HtmlClassAttr -> Ordering)
-> (HtmlClassAttr -> HtmlClassAttr -> Bool)
-> (HtmlClassAttr -> HtmlClassAttr -> Bool)
-> (HtmlClassAttr -> HtmlClassAttr -> Bool)
-> (HtmlClassAttr -> HtmlClassAttr -> Bool)
-> (HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr)
-> (HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr)
-> Ord HtmlClassAttr
HtmlClassAttr -> HtmlClassAttr -> Bool
HtmlClassAttr -> HtmlClassAttr -> Ordering
HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
$cmin :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
max :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
$cmax :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
>= :: HtmlClassAttr -> HtmlClassAttr -> Bool
$c>= :: HtmlClassAttr -> HtmlClassAttr -> Bool
> :: HtmlClassAttr -> HtmlClassAttr -> Bool
$c> :: HtmlClassAttr -> HtmlClassAttr -> Bool
<= :: HtmlClassAttr -> HtmlClassAttr -> Bool
$c<= :: HtmlClassAttr -> HtmlClassAttr -> Bool
< :: HtmlClassAttr -> HtmlClassAttr -> Bool
$c< :: HtmlClassAttr -> HtmlClassAttr -> Bool
compare :: HtmlClassAttr -> HtmlClassAttr -> Ordering
$ccompare :: HtmlClassAttr -> HtmlClassAttr -> Ordering
Ord,
      Int -> HtmlClassAttr -> ShowS
[HtmlClassAttr] -> ShowS
HtmlClassAttr -> String
(Int -> HtmlClassAttr -> ShowS)
-> (HtmlClassAttr -> String)
-> ([HtmlClassAttr] -> ShowS)
-> Show HtmlClassAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HtmlClassAttr] -> ShowS
$cshowList :: [HtmlClassAttr] -> ShowS
show :: HtmlClassAttr -> String
$cshow :: HtmlClassAttr -> String
showsPrec :: Int -> HtmlClassAttr -> ShowS
$cshowsPrec :: Int -> HtmlClassAttr -> ShowS
Show,
      ReadPrec [HtmlClassAttr]
ReadPrec HtmlClassAttr
Int -> ReadS HtmlClassAttr
ReadS [HtmlClassAttr]
(Int -> ReadS HtmlClassAttr)
-> ReadS [HtmlClassAttr]
-> ReadPrec HtmlClassAttr
-> ReadPrec [HtmlClassAttr]
-> Read HtmlClassAttr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HtmlClassAttr]
$creadListPrec :: ReadPrec [HtmlClassAttr]
readPrec :: ReadPrec HtmlClassAttr
$creadPrec :: ReadPrec HtmlClassAttr
readList :: ReadS [HtmlClassAttr]
$creadList :: ReadS [HtmlClassAttr]
readsPrec :: Int -> ReadS HtmlClassAttr
$creadsPrec :: Int -> ReadS HtmlClassAttr
Read,
      NonEmpty HtmlClassAttr -> HtmlClassAttr
HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
(HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr)
-> (NonEmpty HtmlClassAttr -> HtmlClassAttr)
-> (forall b. Integral b => b -> HtmlClassAttr -> HtmlClassAttr)
-> Semigroup HtmlClassAttr
forall b. Integral b => b -> HtmlClassAttr -> HtmlClassAttr
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> HtmlClassAttr -> HtmlClassAttr
$cstimes :: forall b. Integral b => b -> HtmlClassAttr -> HtmlClassAttr
sconcat :: NonEmpty HtmlClassAttr -> HtmlClassAttr
$csconcat :: NonEmpty HtmlClassAttr -> HtmlClassAttr
<> :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
$c<> :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
Semigroup,
      Semigroup HtmlClassAttr
HtmlClassAttr
Semigroup HtmlClassAttr
-> HtmlClassAttr
-> (HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr)
-> ([HtmlClassAttr] -> HtmlClassAttr)
-> Monoid HtmlClassAttr
[HtmlClassAttr] -> HtmlClassAttr
HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [HtmlClassAttr] -> HtmlClassAttr
$cmconcat :: [HtmlClassAttr] -> HtmlClassAttr
mappend :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
$cmappend :: HtmlClassAttr -> HtmlClassAttr -> HtmlClassAttr
mempty :: HtmlClassAttr
$cmempty :: HtmlClassAttr
Monoid
    )
  deriving stock
    ( (forall x. HtmlClassAttr -> Rep HtmlClassAttr x)
-> (forall x. Rep HtmlClassAttr x -> HtmlClassAttr)
-> Generic HtmlClassAttr
forall x. Rep HtmlClassAttr x -> HtmlClassAttr
forall x. HtmlClassAttr -> Rep HtmlClassAttr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HtmlClassAttr x -> HtmlClassAttr
$cfrom :: forall x. HtmlClassAttr -> Rep HtmlClassAttr x
Generic
    )

instance Out HtmlClassAttr

instance IsList HtmlClassAttr where
  type Item HtmlClassAttr = Text
  fromList :: [Item HtmlClassAttr] -> HtmlClassAttr
fromList = [Item HtmlClassAttr] -> HtmlClassAttr
coerce
  toList :: HtmlClassAttr -> [Item HtmlClassAttr]
toList = HtmlClassAttr -> [Item HtmlClassAttr]
coerce

--
-- TODO : use bootstrap tabs/panels to provide
-- basic and advanced view options for users.
--
data Layout
  = BasicLayout
  | AdvancedLayout
  deriving stock
    ( Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq,
      Eq Layout
Eq Layout
-> (Layout -> Layout -> Ordering)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool)
-> (Layout -> Layout -> Layout)
-> (Layout -> Layout -> Layout)
-> Ord Layout
Layout -> Layout -> Bool
Layout -> Layout -> Ordering
Layout -> Layout -> Layout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Layout -> Layout -> Layout
$cmin :: Layout -> Layout -> Layout
max :: Layout -> Layout -> Layout
$cmax :: Layout -> Layout -> Layout
>= :: Layout -> Layout -> Bool
$c>= :: Layout -> Layout -> Bool
> :: Layout -> Layout -> Bool
$c> :: Layout -> Layout -> Bool
<= :: Layout -> Layout -> Bool
$c<= :: Layout -> Layout -> Bool
< :: Layout -> Layout -> Bool
$c< :: Layout -> Layout -> Bool
compare :: Layout -> Layout -> Ordering
$ccompare :: Layout -> Layout -> Ordering
Ord,
      Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show,
      ReadPrec [Layout]
ReadPrec Layout
Int -> ReadS Layout
ReadS [Layout]
(Int -> ReadS Layout)
-> ReadS [Layout]
-> ReadPrec Layout
-> ReadPrec [Layout]
-> Read Layout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Layout]
$creadListPrec :: ReadPrec [Layout]
readPrec :: ReadPrec Layout
$creadPrec :: ReadPrec Layout
readList :: ReadS [Layout]
$creadList :: ReadS [Layout]
readsPrec :: Int -> ReadS Layout
$creadsPrec :: Int -> ReadS Layout
Read,
      (forall x. Layout -> Rep Layout x)
-> (forall x. Rep Layout x -> Layout) -> Generic Layout
forall x. Rep Layout x -> Layout
forall x. Layout -> Rep Layout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Layout x -> Layout
$cfrom :: forall x. Layout -> Rep Layout x
Generic,
      Int -> Layout
Layout -> Int
Layout -> [Layout]
Layout -> Layout
Layout -> Layout -> [Layout]
Layout -> Layout -> Layout -> [Layout]
(Layout -> Layout)
-> (Layout -> Layout)
-> (Int -> Layout)
-> (Layout -> Int)
-> (Layout -> [Layout])
-> (Layout -> Layout -> [Layout])
-> (Layout -> Layout -> [Layout])
-> (Layout -> Layout -> Layout -> [Layout])
-> Enum Layout
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Layout -> Layout -> Layout -> [Layout]
$cenumFromThenTo :: Layout -> Layout -> Layout -> [Layout]
enumFromTo :: Layout -> Layout -> [Layout]
$cenumFromTo :: Layout -> Layout -> [Layout]
enumFromThen :: Layout -> Layout -> [Layout]
$cenumFromThen :: Layout -> Layout -> [Layout]
enumFrom :: Layout -> [Layout]
$cenumFrom :: Layout -> [Layout]
fromEnum :: Layout -> Int
$cfromEnum :: Layout -> Int
toEnum :: Int -> Layout
$ctoEnum :: Int -> Layout
pred :: Layout -> Layout
$cpred :: Layout -> Layout
succ :: Layout -> Layout
$csucc :: Layout -> Layout
Enum,
      Layout
Layout -> Layout -> Bounded Layout
forall a. a -> a -> Bounded a
maxBound :: Layout
$cmaxBound :: Layout
minBound :: Layout
$cminBound :: Layout
Bounded
    )

instance Out Layout

bfsAutoFocus :: RenderMessage site msg => msg -> FieldSettings site
bfsAutoFocus :: forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
bfsAutoFocus msg
msg =
  FieldSettings site
bfsStandard {fsAttrs :: [(Text, Text)]
fsAttrs = (Text
"autofocus", Text
"") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: FieldSettings site -> [(Text, Text)]
forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings site
bfsStandard}
  where
    bfsStandard :: FieldSettings site
bfsStandard = msg -> FieldSettings site
forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
bfs msg
msg

bfsDisabled :: RenderMessage site msg => msg -> FieldSettings site
bfsDisabled :: forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
bfsDisabled msg
msg =
  FieldSettings site
bfsStandard {fsAttrs :: [(Text, Text)]
fsAttrs = (Text
"disabled", Text
"") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: FieldSettings site -> [(Text, Text)]
forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings site
bfsStandard}
  where
    bfsStandard :: FieldSettings site
bfsStandard = msg -> FieldSettings site
forall site msg.
RenderMessage site msg =>
msg -> FieldSettings site
bfs msg
msg

fromTextField ::
  forall m a.
  ( Monad m,
    From Text a,
    From a Text,
    'False ~ (Text == a),
    'False ~ (a == Text),
    RenderMessage (HandlerSite m) FormMessage
  ) =>
  Field m a
fromTextField :: forall (m :: * -> *) a.
(Monad m, From Text a, From a Text, 'False ~ (Text == a),
 'False ~ (a == Text), RenderMessage (HandlerSite m) FormMessage) =>
Field m a
fromTextField =
  Field :: forall (m :: * -> *) a.
([Text]
 -> [FileInfo]
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe a)))
-> FieldViewFunc m a -> Enctype -> Field m a
Field
    { fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse = \[Text]
f [FileInfo]
xs ->
        ((Text -> a
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (Text -> a) -> Maybe Text -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Text -> Maybe a)
-> Either (SomeMessage (HandlerSite m)) (Maybe Text)
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either (SomeMessage (HandlerSite m)) (Maybe Text)
 -> Either (SomeMessage (HandlerSite m)) (Maybe a))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe Text))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field m Text
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe Text))
forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse Field m Text
txtField [Text]
f [FileInfo]
xs,
      fieldView :: FieldViewFunc m a
fieldView = \Text
theId Text
fieldName [(Text, Text)]
attrs Either Text a
val Bool
isReq ->
        Field m Text -> FieldViewFunc m Text
forall (m :: * -> *) a. Field m a -> FieldViewFunc m a
fieldView
          Field m Text
txtField
          Text
theId
          Text
fieldName
          [(Text, Text)]
attrs
          (a -> Text
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (a -> Text) -> Either Text a -> Either Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text a
val)
          Bool
isReq,
      fieldEnctype :: Enctype
fieldEnctype =
        Field m Text -> Enctype
forall (m :: * -> *) a. Field m a -> Enctype
fieldEnctype Field m Text
txtField
    }
  where
    txtField :: Field m Text
    txtField :: Field m Text
txtField = Field m Text
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField

toText ::
  ( From a Text,
    'False ~ (Text == a),
    'False ~ (a == Text)
  ) =>
  a ->
  Text
toText :: forall a.
(From a Text, 'False ~ (Text == a), 'False ~ (a == Text)) =>
a -> Text
toText =
  a -> Text
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from

newListWidget ::
  [[(AppMessage, AppMessage)]] ->
  Maybe Widget
newListWidget :: [[(AppMessage, AppMessage)]] -> Maybe Widget
newListWidget =
  Maybe AppMessage
-> Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget
newGenListWidget Maybe AppMessage
forall a. Maybe a
Nothing (Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget)
-> Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2

newNamedListWidget ::
  AppMessage ->
  [[(AppMessage, AppMessage)]] ->
  Maybe Widget
newNamedListWidget :: AppMessage -> [[(AppMessage, AppMessage)]] -> Maybe Widget
newNamedListWidget AppMessage
title =
  Maybe AppMessage
-> Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget
newGenListWidget (AppMessage -> Maybe AppMessage
forall a. a -> Maybe a
Just AppMessage
title) (Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget)
-> Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3

newGenListWidget ::
  Maybe AppMessage ->
  Rational ->
  [[(AppMessage, AppMessage)]] ->
  Maybe Widget
newGenListWidget :: Maybe AppMessage
-> Rational -> [[(AppMessage, AppMessage)]] -> Maybe Widget
newGenListWidget Maybe AppMessage
_ Rational
_ [] =
  Maybe Widget
forall a. Maybe a
Nothing
newGenListWidget Maybe AppMessage
mTitle Rational
colProp [[(AppMessage, AppMessage)]]
rawRows =
  Widget -> Maybe Widget
forall a. a -> Maybe a
Just $(widgetFile "named_list")
  where
    idxRows :: [(Natural, [(AppMessage, AppMessage)])]
    idxRows :: [(Natural, [(AppMessage, AppMessage)])]
idxRows = [Natural]
-> [[(AppMessage, AppMessage)]]
-> [(Natural, [(AppMessage, AppMessage)])]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Natural
0 ..] [[(AppMessage, AppMessage)]]
rawRows
    c1 :: Integer
    c1 :: Integer
c1 = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ Rational
12 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
colProp
    c2 :: Integer
    c2 :: Integer
c2 = Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
c1