[WIP] Bridge Uid type and replace to Uid String in types

front-ps/src/Guide/Api/Http.purs

@@ -11,6 +11,7 @@ import Data.Either (Either(..), either)
 import Data.Generic (class Generic)
 import Guide.Api.ClientTypes (CCategoryDetail)
 import Guide.Types (CGrandCategories, CategoryName(..), Users)
+import Guide.Utils (Uid(..))
 import Lib.IsomorphicFetch (FETCH, fetch)
 
 apiEndpoint :: String
@@ -34,7 +35,7 @@ fetchGrandCategories (CategoryName catName) = do
 
 -- TODO: Use `Uid Category` instead of `String` as second function parameter
 -- if we have found a way to bridge `Uid a` properly from `Haskell` to `PS`
-fetchCategory :: forall eff. CategoryName -> String -> Aff (fetch :: FETCH | eff) (Either String CCategoryDetail)
-fetchCategory (CategoryName catName) catId = do
-  res <- attempt <<< fetch $ apiEndpoint <> catName <> "/category/" <> catId
+fetchCategory :: forall eff. CategoryName -> (Uid String) -> Aff (fetch :: FETCH | eff) (Either String CCategoryDetail)
+fetchCategory (CategoryName catName) (Uid catId) = do
+  res <- attempt <<< fetch $ apiEndpoint <> catName <> "/category/" <> catId.uidToText
   pure $ either (Left <<< show) decodeJson res

front-ps/src/Guide/Events.purs

@@ -2,6 +2,7 @@ module Guide.Events where
 
 import Guide.Api.ClientTypes (CCategoryDetail)
 import Data.Either (Either)
+import Guide.Utils (Uid)
 import Guide.Routes (Route)
 import Guide.Types (CGrandCategories, CategoryName, Users)
 import Pux.DOM.Events (DOMEvent)
@@ -13,7 +14,7 @@ data Event
   -- API
   | RequestGrandCategories CategoryName
   | ReceiveGrandCategories (Either String CGrandCategories)
-  | RequestCategory CategoryName String -- (String == Uid Category)
+  | RequestCategory CategoryName (Uid String) -- (String == Uid Category)
   -- TODO: ^ Use `Uid Category` instead of `String` as second type parameter
   -- if we have found a way to bridge `Uid a` properly from `Haskell` to `PS`
   | ReceiveCategory (Either String CCategoryDetail)

front-ps/src/Guide/Routes.purs

@@ -6,13 +6,14 @@ import Control.Alt ((<|>))
 import Data.Generic (class Generic, gEq, gShow)
 import Data.Maybe (fromMaybe)
 import Guide.Types (CategoryName(..))
+import Guide.Utils (Uid(..))
 import Pux.Router (end, lit, router, str)
 
 data Route
     = Home
     | CategoryOverview CategoryName
-    | CategoryDetail CategoryName String -- String == (Uid Category)
-    -- TODO: Use `Uid Category` instead of `String`
+    | CategoryDetail CategoryName (Uid String) -- String == (Uid Category)
+    -- TODO: Use `Uid Category` instead of `Uid String`
     -- if we have found a way to bridge `Uid a` properly from `Haskell` to `PS`
     | Playground
     | NotFound String
@@ -30,7 +31,7 @@ match url = fromMaybe (NotFound url) $ router url $
   CategoryOverview <<< CategoryName <$> (lit categoryLit *> str) <* end
   <|>
   CategoryDetail <<< CategoryName <$> (lit categoryLit *> str)
-                                  <*> str <* end
+                                  <*> ((\s -> Uid {uidToText : s}) <$> str) <* end
   <|>
   Playground <$ (lit playgroundLit) <* end
 
@@ -56,8 +57,8 @@ categoryUrl (CategoryName name) = (litUrl categoryLit) <> (litUrl name)
 categoryDetailLit :: String
 categoryDetailLit = "detail"
 
-categoryDetailUrl :: CategoryName -> String -> String
-categoryDetailUrl catName catId = (categoryUrl catName) <> (litUrl catId)
+categoryDetailUrl :: CategoryName -> Uid String -> String
+categoryDetailUrl catName (Uid catId) = (categoryUrl catName) <> (litUrl catId.uidToText)
 
 playgroundLit :: String
 playgroundLit = "playground"

front-ps/src/Guide/View/CategoryDetail.purs

@@ -8,6 +8,7 @@ import Guide.Events (Event(..))
 import Guide.Routes (Route(..), toUrl)
 import Guide.State (State(..))
 import Guide.Types (CategoryName(..))
+import Guide.Utils (Uid(..))
 import Pux.DOM.Events (onClick) as P
 import Pux.DOM.HTML (HTML) as P
 import Text.Smolder.HTML (div, h1, a) as S
@@ -15,10 +16,10 @@ import Text.Smolder.HTML.Attributes (href) as S
 import Text.Smolder.Markup ((#!), (!))
 import Text.Smolder.Markup (text) as S
 
-view :: CategoryName -> String -> State -> P.HTML Event
-view (CategoryName cName) catId (State st) =
+view :: CategoryName -> Uid String -> State -> P.HTML Event
+view (CategoryName cName) (Uid catId) (State st) =
   S.div $ do
-    S.h1 $ S.text (cName <> " - " <> catId)
+    S.h1 $ S.text (cName <> " - " <> catId.uidToText)
     S.a ! S.href (toUrl Home)
         #! P.onClick (Navigate $ toUrl Home)
         $ S.text "Back to Home"

front-ps/src/Guide/View/CategoryOverview.purs

@@ -12,6 +12,7 @@ import Guide.Routes (Route(..), toUrl)
 import Guide.State (State(..))
 import Guide.Types (CGrandCategories, CategoryName(..))
 import Guide.Util.DOMUtil (mkKey)
+import Guide.Utils (Uid(..))
 import Network.RemoteData (RemoteData(..))
 import Pux.DOM.Events (onClick) as P
 import Pux.DOM.HTML (HTML) as P
@@ -68,7 +69,7 @@ catOverviewView :: State -> CCategoryOverview -> P.HTML Event
 catOverviewView (State st) (CCategoryOverview cat) =
   let url = toUrl $ CategoryDetail st.currentCategoryName cat.ccoUid in
   S.li
-    ! P.key cat.ccoUid
+    ! P.key ((\(Uid t) -> t.uidToText) cat.ccoUid)
     $ S.a
       ! S.href url
       #! P.onClick (Navigate url)

src/Guide/Api/ClientTypes.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 {- |
@@ -33,13 +33,13 @@ import Guide.Types.Core (Category, CategoryStatus(..), Item, ItemKind, Trait
   , content, created, group_, description, pros, prosDeleted, cons, consDeleted, ecosystem
   , notes, link, kind, name, items, notes, status, uid, title, group_
   )
-import Guide.Utils (Uid, Url)
+import Guide.Utils (Uid(..), Url)
 import Guide.Markdown (MarkdownBlock, MarkdownInline, MarkdownTree, mdHtml, mdText)
 import Guide.Views.Utils (categoryLink)
 
 -- | Client type of `Category`, which describes a category overview
 data CCategoryOverview = CCategoryOverview
-  { ccoUid    :: Uid Category
+  { ccoUid    :: Uid String
   , ccoTitle  :: Text
   , ccoLink  :: Text
   } deriving (Show, Generic)
@@ -49,7 +49,7 @@ instance A.ToJSON CCategoryOverview where
 
 toCCategoryOverview :: Category -> CCategoryOverview
 toCCategoryOverview cat = CCategoryOverview
-  { ccoUid = cat^.uid
+  { ccoUid = toUid (cat^.uid)
   , ccoTitle = cat^.title
   , ccoLink = categoryLink cat
   }
@@ -76,7 +76,7 @@ toCGrandCategory cats = CGrandCategory
 
 -- | Client type of `Category`, which describes a category detail
 data CCategoryDetail = CCategoryDetail
-  { ccdUid :: Uid Category
+  { ccdUid :: Uid String
   , ccdTitle :: Text
   , ccdGroup :: Text
   , ccdDescription :: CMarkdown
@@ -90,7 +90,7 @@ instance A.ToJSON CCategoryDetail where
 
 toCCategoryDetail :: Category -> CCategoryDetail
 toCCategoryDetail cat = CCategoryDetail
-  { ccdUid = cat^.uid
+  { ccdUid = toUid (cat^.uid)
   , ccdTitle = cat^.title
   , ccdGroup = cat^.group_
   , ccdDescription = toCMarkdown $ cat^.notes
@@ -100,7 +100,7 @@ toCCategoryDetail cat = CCategoryDetail
 
 -- | Client type of `Item`
 data CItem = CItem
-  { ciUid :: Uid Item
+  { ciUid :: Uid String
   , ciName :: Text
   , ciCreated :: UTCTime
   , ciGroup :: Maybe Text
@@ -120,7 +120,7 @@ instance A.ToJSON CItem where
 
 toCItem :: Item -> CItem
 toCItem item = CItem
-  { ciUid = item ^. uid
+  { ciUid = toUid (item ^. uid)
   , ciName = item ^. name
   , ciCreated = item ^. created
   , ciGroup = item ^. group_
@@ -136,7 +136,7 @@ toCItem item = CItem
   }
 
 data CTrait = CTrait
-  { ctUid :: Uid Trait
+  { ctUid :: Uid String
   , ctContent :: CMarkdown
   } deriving (Show, Generic)
 
@@ -146,7 +146,7 @@ instance A.ToJSON CTrait where
 
 toCTrait :: Trait -> CTrait
 toCTrait trait = CTrait
-  { ctUid = trait ^. uid
+  { ctUid = toUid (trait ^. uid)
   , ctContent = toCMarkdown $ trait ^. content
   }
 
@@ -177,3 +177,6 @@ instance ToCMardown MarkdownTree where
     { text = md^.mdText
     , html = T.toStrict . renderText $ toHtml md
     }
+
+toUid :: Uid a -> Uid b
+toUid (Uid t) = Uid t

src/Guide/Utils.hs

@@ -299,7 +299,8 @@ sockAddrToIP _ = Nothing
 newtype Uid a = Uid {uidToText :: Text}
   deriving (Eq, Ord, Show, Data,
             ToHttpApiData, FromHttpApiData,
-            T.Buildable, Hashable, A.ToJSON)
+            T.Buildable, Hashable, A.ToJSON,
+            Generic)
 
 -- This instance is written manually because otherwise it produces a warning:
 --     • Redundant constraint: SafeCopy a

src/purescript/Main.hs

@@ -1,7 +1,7 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE OverloadedStrings #-}
-
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
 
 module Main
@@ -11,13 +11,18 @@ module Main
 import Prelude
 
 import Data.Proxy (Proxy (..))
-import Language.PureScript.Bridge (BridgeBuilder, BridgePart, Language( Haskell ), SumType,
-                                    PSType, TypeInfo (..), (<|>), (^==), buildBridge,
-                                    defaultBridge, typeName, mkSumType, writePSTypes)
+import Language.PureScript.Bridge ( BridgePart, Language( Haskell ), PSType,
+                                    SumType, TypeInfo (..), (<|>),
+                                    (^==), buildBridge, defaultBridge,
+                                    typeName, mkSumType, writePSTypes)
 import Language.PureScript.Bridge.PSTypes (psString)
-import Guide.Api.ClientTypes (CCategoryDetail, CCategoryOverview, CGrandCategory, CItem, CTrait, CMarkdown)
+import Language.PureScript.Bridge.TypeParameters (A)
+import Guide.Api.ClientTypes ( CCategoryDetail, CCategoryOverview
+                             , CGrandCategory, CItem, CTrait, CMarkdown
+                             )
 import Guide.Types.Hue (Hue)
 import Guide.Types.Core (CategoryStatus, ItemKind)
+import Guide.Utils (Uid)
 
 path :: FilePath
 path = "front-ps/src/Generated"
@@ -25,13 +30,10 @@ path = "front-ps/src/Generated"
 psPosixTime :: PSType
 psPosixTime = TypeInfo "" "Data.Time.NominalDiffTime" "NominalDiffTime" []
 
-posixTimeBridge :: BridgeBuilder PSType
+posixTimeBridge :: BridgePart
 posixTimeBridge =
   typeName ^== "NominalDiffTime" >> pure psPosixTime
 
-uidBridge :: BridgePart
-uidBridge = typeName ^== "Uid" >> pure psString
-
 byteStringBridge :: BridgePart
 byteStringBridge = typeName ^== "ByteString" >> pure psString
 
@@ -39,25 +41,24 @@ byteStringBridge = typeName ^== "ByteString" >> pure psString
 utcTimeBridge :: BridgePart
 utcTimeBridge = typeName ^== "UTCTime" >> pure psString
 
-
-bridge :: BridgeBuilder PSType
+bridge :: BridgePart
 bridge = defaultBridge
   <|> posixTimeBridge
-  <|> uidBridge
   <|> byteStringBridge
   <|> utcTimeBridge
 
 clientTypes :: [SumType  'Haskell]
 clientTypes =
-  [ mkSumType (Proxy :: Proxy CGrandCategory)
-  , mkSumType (Proxy :: Proxy CCategoryDetail)
-  , mkSumType (Proxy :: Proxy CCategoryOverview)
-  , mkSumType (Proxy :: Proxy Hue)
-  , mkSumType (Proxy :: Proxy CategoryStatus)
-  , mkSumType (Proxy :: Proxy CItem)
-  , mkSumType (Proxy :: Proxy ItemKind)
-  , mkSumType (Proxy :: Proxy CTrait)
-  , mkSumType (Proxy :: Proxy CMarkdown)
+  [ mkSumType (Proxy @CGrandCategory)
+  , mkSumType (Proxy @CCategoryDetail)
+  , mkSumType (Proxy @CCategoryOverview)
+  , mkSumType (Proxy @Hue)
+  , mkSumType (Proxy @CategoryStatus)
+  , mkSumType (Proxy @CItem)
+  , mkSumType (Proxy @ItemKind)
+  , mkSumType (Proxy @CTrait)
+  , mkSumType (Proxy @CMarkdown)
+  , mkSumType (Proxy @(Uid A))
   ]
 
 -- FIXME: Currently `Uid a` defined in `Guide.Utils` is bridged into a `String`.