Added NRDB Links

Main.hs

@@ -13,6 +13,7 @@ import Timestamp
 import Preview
 import Yesod
 import Config
+import Nrdb
 
 data ProtocolSeven = ProtocolSeven
 
@@ -56,6 +57,10 @@ getHomeR = defaultLayout $ do
    let bbout = map show $ catMaybes $ inBoth (bx ib) (tail $ bx b)
    let dpout = sort $ map show $ map (\(Ir n) -> n) i
    let pr = getPreview ts
+   let (pdi,pdo,bbi,bbo) = extractPreview pr
+   let nrdbFormat = nrdbSearch (((map (\(Ir n) -> n) i) ++ (map (\(Or n _) -> n) o)),(catMaybes (bx b)))
+   let nrdbIn = nrdbSearch (pdi,catMaybes [bbi])
+   let nrdbOut = nrdbSearch (pdo,catMaybes [bbo])
    setTitle "Protocol Seven"
    toWidget [lucius|
       html {
@@ -108,6 +113,7 @@ getHomeR = defaultLayout $ do
          display: flex;
          flex-direction: row;
          flex-wrap: wrap;
+         padding: 10px;
       }
 
       ul {
@@ -134,6 +140,7 @@ getHomeR = defaultLayout $ do
    toWidgetBody [hamlet|
       <section class="rotation">
          <h2>Format for #{showMonth month} #{year}:
+         <a href=#{nrdbFormat}>Click Here for NetrunnerDB
          <div class="flexboxcontainer">
             <div class="rotationLeft">
                <h3>Evergreen:
@@ -153,6 +160,7 @@ getHomeR = defaultLayout $ do
             $maybe (pin, pout, pbin, pbout) <- pr
                <div class="upcomingIn">
                   <h3>In:
+                  <a href=#{nrdbIn}>Click Here for NetrunnerDB
                   <ul>
                      $maybe pbbin <- pbin
                         <li>+ #{show pbbin}
@@ -160,6 +168,7 @@ getHomeR = defaultLayout $ do
                         <li>+ #{show indp}
                <div class="upcomingOut">
                   <h3>Out:
+                  <a href=#{nrdbOut}>Click Here for NetrunnerDB
                   <ul>
                      $maybe pbbout <- pbout
                         <li>- #{show pbbout}

Nrdb.hs

@@ -0,0 +1,58 @@
+module Nrdb where
+
+import Packs
+import Data.List
+
+nrdbSearch :: ([DataPack], [BigBox]) -> String
+nrdbSearch (d, b) =
+   "https://netrunnerdb.com/find/?q=e%3A" ++
+   intercalate "%7C" (
+      (map nrdbPackCodes d) ++
+      (map nrdbBoxCodes b)
+   )
+
+nrdbPackCodes :: DataPack -> String
+nrdbPackCodes Lunar1 = "up"
+nrdbPackCodes Lunar2 = "tsb"
+nrdbPackCodes Lunar3 = "fc"
+nrdbPackCodes Lunar4 = "uao"
+nrdbPackCodes Lunar5 = "atr"
+nrdbPackCodes Lunar6 = "ts"
+nrdbPackCodes Sansan1 = "val"
+nrdbPackCodes Sansan2 = "bb"
+nrdbPackCodes Sansan3 = "cc"
+nrdbPackCodes Sansan4 = "uw"
+nrdbPackCodes Sansan5 = "oh"
+nrdbPackCodes Sansan6 = "uot"
+nrdbPackCodes Mumbad1 = "kg"
+nrdbPackCodes Mumbad2 = "bf"
+nrdbPackCodes Mumbad3 = "dag"
+nrdbPackCodes Mumbad4 = "si"
+nrdbPackCodes Mumbad5 = "tlm"
+nrdbPackCodes Mumbad6 = "ftm"
+nrdbPackCodes Flash1 = "23s"
+nrdbPackCodes Flash2 = "bm"
+nrdbPackCodes Flash3 = "es"
+nrdbPackCodes Flash4 = "in"
+nrdbPackCodes Flash5 = "ml"
+nrdbPackCodes Flash6 = "qu"
+nrdbPackCodes Red1 = "dc"
+nrdbPackCodes Red2 = "so"
+nrdbPackCodes Red3 = "eas"
+nrdbPackCodes Red4 = "baw"
+nrdbPackCodes Red5 = "fm"
+nrdbPackCodes Red6 = "cd"
+nrdbPackCodes Kitara1 = "ss"
+nrdbPackCodes Kitara2 = "dtwn"
+nrdbPackCodes Kitara3 = "cotc"
+nrdbPackCodes Kitara4 = "tdatd"
+nrdbPackCodes Kitara5 = "win"
+nrdbPackCodes Kitara6 = "ka"
+
+nrdbBoxCodes :: BigBox -> String
+nrdbBoxCodes Cc = "cac"
+nrdbBoxCodes Hp = "hap"
+nrdbBoxCodes Oc = "oac"
+nrdbBoxCodes Dd = "dad"
+nrdbBoxCodes Td = "td"
+nrdbBoxCodes Rr = "rar"

Preview.hs

@@ -9,6 +9,10 @@ import Format
 
 type Preview = ([DataPack], [DataPack], Maybe BigBox, Maybe BigBox)
 
+extractPreview :: Maybe Preview -> ([DataPack],[DataPack],Maybe BigBox, Maybe BigBox)
+extractPreview Nothing = ([],[],Nothing, Nothing)
+extractPreview (Just (i,o,ib,ob)) = (i,o,ib,ob)
+
 changes :: Eq a => [a] -> [a] -> [a]
 changes x y = filter (\n -> not $ n `elem` y) x