summaryrefslogtreecommitdiff
path: root/Hero/App.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Hero/App.hs')
-rw-r--r--Hero/App.hs38
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)