Initialize Hero database

1 files changed, 31 insertions, 7 deletions

diff --git a/Hero/App.hs b/Hero/App.hs
index a254d80..3aca8be 100644
--- a/Hero/App.hs
+++ b/Hero/App.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -19,6 +21,7 @@ import Data.Aeson
     genericParseJSON,
     genericToJSON,
   )
+import Data.Data (Data, Typeable)
 import qualified Data.List as List
 import qualified Data.List.Split as List
 import Data.Proxy (Proxy (..))
@@ -39,6 +42,8 @@ import Servant.API
   ( (:<|>) (..),
     (:>),
     Capture,
+    ToHttpApiData,
+    FromHttpApiData,
     URI (..),
     safeLink,
   )
@@ -62,7 +67,26 @@ onPreventClick action =
     (\() -> action)
 
 -- TODO: make ComicId a hashid https://hackage.haskell.org/package/hashids-1.0.2.4/docs/Web-Hashids.html
-type ComicId = String
+newtype ComicId
+  = ComicId String
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Data,
+      Typeable,
+      Generic,
+      ToMisoString,
+      IsString,
+      ToHttpApiData,
+      FromHttpApiData
+    )
+
+instance ToJSON ComicId where
+  toJSON = genericToJSON Data.Aeson.defaultOptions
+
+instance FromJSON ComicId where
+  parseJSON = genericParseJSON Data.Aeson.defaultOptions
 
 -- | Class for turning different string types to snakeCase.
 class CanSnakeCase str where
@@ -84,7 +108,7 @@ data Comic
         comicIssue :: Text,
         comicDescription :: Text
       }
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Generic, Data, Ord)
 
 instance ToJSON Comic where
   toJSON = genericToJSON Data.Aeson.defaultOptions
@@ -317,11 +341,11 @@ initModel uri_ =
 -- | Hacky way to initialize the 'ComicReaderState' from the URI.
 detectPlayerState :: URI -> ComicReaderState
 detectPlayerState u = case List.splitOn "/" $ uriPath u of
-  ["", "comic", id, pg, "experience"] -> ChooseExperience id $ toPage pg
-  ["", "comic", id, _, "video"] -> Watching id
-  ["", "comic", id, pg, "full"] -> Reading Full id $ toPage pg
-  ["", "comic", id, pg] -> Reading Spread id $ toPage pg
-  ["", "comic", id] -> Cover id
+  ["", "comic", id, pg, "experience"] -> ChooseExperience (ComicId id) (toPage pg)
+  ["", "comic", id, _, "video"] -> Watching $ ComicId id
+  ["", "comic", id, pg, "full"] -> Reading Full (ComicId id) (toPage pg)
+  ["", "comic", id, pg] -> Reading Spread (ComicId id) (toPage pg)
+  ["", "comic", id] -> Cover $ ComicId id
   _ -> NotReading
   where
     toPage pg = fromMaybe 1 (readMaybe pg :: Maybe Page)