diff options
Diffstat (limited to 'Hero/App.hs')
-rw-r--r-- | Hero/App.hs | 38 |
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) |