git.iko.soy/typeable/http-api-data
on 27f0a6f help sign in
typeable/http-api-data/Web/PathPieces/Internal.hs
164 lines 5.7 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE Rank2Types #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TypeSynonymInstances #-}
8-- |
9-- Convert Haskell values to and from route pieces.
10module Web.PathPieces.Internal where
12import Data.Monoid
13import Data.Int
14import Data.Word
15import qualified Data.Text as S
16import qualified Data.Text.Lazy as L
17import Data.Version (Version)
18import Data.Time (Day)
19import Text.Read (readMaybe)
21import Unsafe.Coerce
23#if MIN_VERSION_base(4,8,0)
24import Data.Void (Void)
25#endif
27import Web.HttpApiData
28import Web.HttpApiData.Internal (parseMaybeTextData)
30-- | Convert Haskell values to and from route piece.
31class PathPiece s where
32 -- | Convert from route piece.
33 fromPathPiece :: S.Text -> Maybe s
34 default fromPathPiece :: FromHttpApiData s => S.Text -> Maybe s
35 fromPathPiece = defaultFromPathPiece
37 -- | Convert to route piece.
38 toPathPiece :: s -> S.Text
39 default toPathPiece :: ToHttpApiData s => s -> S.Text
40 toPathPiece = defaultToPathPiece
42instance PathPiece ()
43instance PathPiece Char
44instance PathPiece Bool
45instance PathPiece Ordering
46instance PathPiece Double
47instance PathPiece Float
48instance PathPiece Int
49instance PathPiece Int8
50instance PathPiece Int16
51instance PathPiece Int32
52instance PathPiece Int64
53instance PathPiece Integer
54instance PathPiece Word
55instance PathPiece Word8
56instance PathPiece Word16
57instance PathPiece Word32
58instance PathPiece Word64
59instance PathPiece String
60instance PathPiece S.Text
61instance PathPiece L.Text
62instance PathPiece Day
63instance PathPiece Version
65#if MIN_VERSION_base(4,8,0)
66instance PathPiece Void
67#endif
69instance PathPiece All
70instance PathPiece Any
72instance PathPiece a => PathPiece (Dual a) where
73 toPathPiece = defaultToPathPiece1
74 fromPathPiece = defaultFromPathPiece1
76instance PathPiece a => PathPiece (Sum a) where
77 toPathPiece = defaultToPathPiece1
78 fromPathPiece = defaultFromPathPiece1
80instance PathPiece a => PathPiece (Product a) where
81 toPathPiece = defaultToPathPiece1
82 fromPathPiece = defaultFromPathPiece1
84instance PathPiece a => PathPiece (First a) where
85 toPathPiece = defaultToPathPiece1
86 fromPathPiece = defaultFromPathPiece1
88instance PathPiece a => PathPiece (Last a) where
89 toPathPiece = defaultToPathPiece1
90 fromPathPiece = defaultFromPathPiece1
92instance PathPiece a => PathPiece (Maybe a) where
93 toPathPiece = defaultToPathPiece1
94 fromPathPiece = defaultFromPathPiece1
96instance (PathPiece a, PathPiece b) => PathPiece (Either a b) where
97 toPathPiece = defaultToPathPiece2
98 fromPathPiece = defaultFromPathPiece2
100-- | Wrapped @'PathPiece'@ value.
101newtype WrappedPathPiece a = WrappedPathPiece { unwrapPathPiece :: a }
103instance PathPiece a => ToHttpApiData (WrappedPathPiece a) where
104 toUrlPiece = toPathPiece . unwrapPathPiece
106instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
107 parseUrlPiece = fmap WrappedPathPiece . parseMaybeTextData fromPathPiece
109-- | Convert value to route piece using @'ToHttpApiData'@ implementation.
110defaultToPathPiece :: ToHttpApiData a => a -> S.Text
111defaultToPathPiece = toUrlPiece
113-- | Convert value from route piece using @'FromHttpApiData'@ implementation.
114defaultFromPathPiece :: FromHttpApiData a => S.Text -> Maybe a
115defaultFromPathPiece = either (const Nothing) Just . parseUrlPiece
117-- | Convert value to route piece using @'PathPiece'@ instance for its parameter.
118defaultToPathPiece1 :: (PathPiece a, ToHttpApiData (f (WrappedPathPiece a))) => f a -> S.Text
119defaultToPathPiece1 = toUrlPiece . (unsafeCoerce :: f a -> f (WrappedPathPiece a))
121-- | Parse value from route piece using @'PathPiece'@ instance for its parameter.
122defaultFromPathPiece1 :: (PathPiece a, FromHttpApiData (f (WrappedPathPiece a))) => S.Text -> Maybe (f a)
123defaultFromPathPiece1 = fmap (unsafeCoerce :: f (WrappedPathPiece a) -> f a) . defaultFromPathPiece
125-- | Convert value to route piece using @'PathPiece'@ instance for its parameters.
126defaultToPathPiece2 :: (PathPiece a, PathPiece b, ToHttpApiData (f (WrappedPathPiece a) (WrappedPathPiece b))) => f a b -> S.Text
127defaultToPathPiece2 = toUrlPiece . (unsafeCoerce :: f a b -> f (WrappedPathPiece a) (WrappedPathPiece b))
129-- | Parse value from route piece using @'PathPiece'@ instance for its parameters.
130defaultFromPathPiece2 :: (PathPiece a, PathPiece b, FromHttpApiData (f (WrappedPathPiece a) (WrappedPathPiece b))) => S.Text -> Maybe (f a b)
131defaultFromPathPiece2 = fmap (unsafeCoerce :: f (WrappedPathPiece a) (WrappedPathPiece b) -> f a b) . defaultFromPathPiece
133-- | Convert Haskell values to and from sequence of route pieces.
134class PathMultiPiece s where
135 -- | Convert from sequence of route pieces.
136 fromPathMultiPiece :: [S.Text] -> Maybe s
137 -- | Convert to sequence of route pieces.
138 toPathMultiPiece :: s -> [S.Text]
140instance PathPiece a => PathMultiPiece [a] where
141 fromPathMultiPiece = mapM fromPathPiece
142 toPathMultiPiece = map toPathPiece
144-- | A function for helping generate free 'PathPiece'
145-- instances for enumeration data types
146-- that have derived 'Read' and 'Show' instances.
147-- Intended to be used like this:
148--
149-- > data MyData = Foo | Bar | Baz
150-- > deriving (Read,Show)
151-- > instance PathPiece MyData where
152-- > fromPathPiece = readFromPathPiece
153-- > toPathPiece = showToPathPiece
154--
155-- Since 0.2.1.
156readFromPathPiece :: Read s => S.Text -> Maybe s
157readFromPathPiece = readMaybe . S.unpack
159-- | See the documentation for 'readFromPathPiece'.
160--
161-- Since 0.2.1.
162showToPathPiece :: Show s => s -> S.Text
163showToPathPiece = S.pack . show