From 5fe9665150b0bfff21cce51c79953c0c2ee442d8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 6 Dec 2023 01:51:47 +0000 Subject: [PATCH] chore: add SemVer instances --- src/Data/SemVer/Instances.hs | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/src/Data/SemVer/Instances.hs b/src/Data/SemVer/Instances.hs index b1aee1d17..aec69c7c8 100644 --- a/src/Data/SemVer/Instances.hs +++ b/src/Data/SemVer/Instances.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Sarah Vaupel +-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel , Sarah Vaupel -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -7,14 +7,45 @@ module Data.SemVer.Instances () where -import ClassyPrelude +import ClassyPrelude.Yesod + import qualified Data.SemVer as SemVer import qualified Data.SemVer.Constraint as SemVer (Constraint(..)) import qualified Data.SemVer.Constraint as SemVer.Constraint +import Data.Either.Combinators (rightToMaybe) +-- import qualified Data.Text as Text +import Model.Types.TH.PathPiece import Web.HttpApiData +instance PathPiece SemVer.Version where + fromPathPiece = rightToMaybe . SemVer.fromText + toPathPiece = SemVer.toText + +-- instance PathPiece SemVer.Constraint where +-- fromPathPiece t = case Text.unpack t of +-- "*" -> Just SemVer.CAny +-- '<' : t' -> SemVer.CLt <$> fromPathPiece t' +-- '<':'=' : t' -> SemVer.CLtEq <$> fromPathPiece t' +-- '>' : t' -> SemVer.CGt <$> fromPathPiece t' +-- '>':'=' : t' -> SemVer.CGtEq <$> fromPathPiece t' +-- _other +-- | (t',t'') <- splitAt " || " t -> SemVer.COr <$> fromPathPiece t' <*> fromPathPiece t'' +-- | (t',t'') <- splitAt " " t -> SemVer.CAnd <$> fromPathPiece t' <*> fromPathPiece t'' +-- | otherwise -> SemVer.CEq <$> fromPathPiece t +-- toPathPiece SemVer.CAny = "*" +-- toPathPiece (SemVer.CLt v) = "<" <> toPathPiece v +-- toPathPiece (SemVer.CLtEq v) = "<=" <> toPathPiece v +-- toPathPiece (SemVer.CGt v) = ">" <> toPathPiece v +-- toPathPiece (SemVer.CGtEq v) = ">=" <> toPathPiece v +-- toPathPiece (SemVer.CEq v) = toPathPiece v +-- toPathPiece (SemVer.CAnd a b) = toPathPiece a <> " " <> toPathPiece b +-- toPathPiece (SemVer.COr a b) = toPathPiece a <> " || " <> toPathPiece b + +derivePersistFieldPathPiece ''SemVer.Version + + instance ToHttpApiData SemVer.Version where toUrlPiece = SemVer.toText