module Serpentine.Try where
import Data.Singletons
import Data.Singletons.TH
import Data.Singletons.Prelude
import Serpentine.Playground
import Data.Text (Text)
import Data.Vinyl.Core
import qualified Data.Text as Text
import Data.Singletons.Class (Applied1(..))
$(singletons [d|
data Item = ItemInt | ItemText | ItemBool
data Crud = AddR | EditR | DeleteR | ViewR
data MyRoute = UsersR
| ProfileR
| HomeR
| DogR Crud
|])
$(singletonsOnly [d|
planCrud :: n -> Crud -> [Piece n]
planCrud n x =
case x of
AddR -> [Static "add"]
EditR -> [Static "edit", Capture n]
DeleteR -> [Static "delete", Capture n]
ViewR -> [Static "view", Capture n]
plan :: MyRoute -> [Piece Item]
plan x =
case x of
UsersR -> [Static "user", Static "index"]
ProfileR -> [Static "profile", Capture ItemInt]
HomeR -> []
DogR crud -> Static "dog" : planCrud ItemInt crud
|])
type family ItemType (x :: Item) where
ItemType ItemInt = Int
ItemType ItemText = Text
ItemType ItemBool = Bool
genDefunSymbols [''ItemType]
renderAnyItem :: SItem x -> Applied1 ItemTypeSym0 x -> Text
renderAnyItem x attr = case x of
SItemInt -> Text.pack $ show $ getApplied1 attr
SItemText -> getApplied1 attr
SItemBool -> if getApplied1 attr then "yes" else "no"
renderMyRoute :: SMyRoute x
-> Rec (Applied1 ItemTypeSym0) (Captures (Plan x))
-> [Text]
renderMyRoute = render (Proxy :: Proxy PlanSym0) sPlan renderAnyItem
test1, test2, test3 :: [Text]
test1 = renderMyRoute SProfileR (Applied1 33 :& RNil)
test2 = renderMyRoute SUsersR RNil
test3 = renderMyRoute (SDogR SViewR) (Applied1 12 :& RNil)