module Network.URI.Template.Types where
import Control.Arrow
import Data.Foldable as F
import Data.Functor.Identity
import Data.List
import qualified Data.String as S
import qualified Data.HashMap.Strict as HS
import Data.Int
import Data.Word
import qualified Data.Map.Strict as MS
import Data.Monoid
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time
import Data.Version
import qualified Data.UUID.Types as UUID
import qualified Data.Vector as V
import Numeric.Natural
data Single
data Associative
data List
data TemplateValue a where
Single :: String -> TemplateValue Single
Associative :: [(TemplateValue Single, TemplateValue Single)] -> TemplateValue Associative
List :: [TemplateValue Single] -> TemplateValue List
instance Show (TemplateValue a) where
show (Single s) = "Single " ++ s
show (Associative as) = "Associative [" ++ intercalate ", " (map formatTuple as) ++ "]"
where
formatTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
show (List s) = "List [" ++ intercalate ", " (map show s) ++ "]"
data WrappedValue where
WrappedValue :: TemplateValue a -> WrappedValue
newtype TemplateString = String { fromString :: String }
deriving (Read, Show, Eq, S.IsString)
newtype AList k v = AList
{ fromAList :: [(k, v)]
} deriving (Read, Show, Eq)
class ToTemplateValue a where
type TemplateRep a :: *
type TemplateRep a = Single
toTemplateValue :: a -> TemplateValue (TemplateRep a)
instance ToTemplateValue () where
toTemplateValue = const $ Single "_"
instance ToTemplateValue Bool where
toTemplateValue = Single . show
instance ToTemplateValue Int where
toTemplateValue = Single . show
instance ToTemplateValue Integer where
toTemplateValue = Single . show
instance ToTemplateValue Natural where
toTemplateValue = Single . show
instance ToTemplateValue Double where
toTemplateValue = Single . show
instance ToTemplateValue Float where
toTemplateValue = Single . show
instance ToTemplateValue Int8 where
toTemplateValue = Single . show
instance ToTemplateValue Int16 where
toTemplateValue = Single . show
instance ToTemplateValue Int32 where
toTemplateValue = Single . show
instance ToTemplateValue Int64 where
toTemplateValue = Single . show
instance ToTemplateValue Word where
toTemplateValue = Single . show
instance ToTemplateValue Word8 where
toTemplateValue = Single . show
instance ToTemplateValue Word16 where
toTemplateValue = Single . show
instance ToTemplateValue Word32 where
toTemplateValue = Single . show
instance ToTemplateValue Word64 where
toTemplateValue = Single . show
instance ToTemplateValue TemplateString where
toTemplateValue = Single . fromString
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Dual a) where
toTemplateValue = toTemplateValue . getDual
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Sum a) where
toTemplateValue = toTemplateValue . getSum
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Product a) where
toTemplateValue = toTemplateValue . getProduct
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (First a) where
toTemplateValue = toTemplateValue . getFirst
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Last a) where
toTemplateValue = toTemplateValue . getLast
instance ToTemplateValue All where
toTemplateValue = toTemplateValue . getAll
instance ToTemplateValue Any where
toTemplateValue = toTemplateValue . getAny
instance ToTemplateValue UUID.UUID where
toTemplateValue = Single . UUID.toString
timeToString :: FormatTime t => String -> t -> String
timeToString fmt = formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
instance ToTemplateValue UTCTime where
toTemplateValue = Single . timeToString "%H:%M:%S%QZ"
instance ToTemplateValue NominalDiffTime where
toTemplateValue = toTemplateValue . (floor :: NominalDiffTime -> Integer)
instance ToTemplateValue LocalTime where
toTemplateValue = Single . timeToString "%H:%M:%S%Q"
instance ToTemplateValue ZonedTime where
toTemplateValue = Single . timeToString "%H:%M:%S%Q%z"
instance ToTemplateValue TimeOfDay where
toTemplateValue = Single . formatTime defaultTimeLocale "%H:%M:%S%Q"
instance ToTemplateValue Day where
toTemplateValue = Single . show
instance ToTemplateValue Version where
toTemplateValue = Single . showVersion
instance ToTemplateValue Ordering where
toTemplateValue = Single . show
instance (ToTemplateValue a, ToTemplateValue b, TemplateRep a ~ Single, TemplateRep b ~ Single) => ToTemplateValue (Either a b) where
toTemplateValue = either toTemplateValue toTemplateValue
instance (ToTemplateValue a, (TemplateRep a) ~ Single) => ToTemplateValue [a] where
type TemplateRep [a] = List
toTemplateValue = List . map toTemplateValue
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (NE.NonEmpty a) where
type TemplateRep (NE.NonEmpty a) = List
toTemplateValue = toTemplateValue . NE.toList
instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (AList k v) where
type TemplateRep (AList k v) = Associative
toTemplateValue = Associative . map (toTemplateValue *** toTemplateValue) . fromAList
instance (ToTemplateValue a, (TemplateRep a) ~ Single) => ToTemplateValue (V.Vector a) where
type TemplateRep (V.Vector a) = List
toTemplateValue = List . F.toList . fmap toTemplateValue
instance ToTemplateValue T.Text where
toTemplateValue = Single . T.unpack
instance ToTemplateValue TL.Text where
toTemplateValue = Single . TL.unpack
instance (ToTemplateValue a, TemplateRep a ~ Single) => ToTemplateValue (Maybe a) where
toTemplateValue = maybe (Single "") toTemplateValue
instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (HS.HashMap k v) where
type TemplateRep (HS.HashMap k v) = Associative
toTemplateValue = toTemplateValue . AList . HS.toList
instance (ToTemplateValue k, (TemplateRep k) ~ Single, ToTemplateValue v, (TemplateRep v) ~ Single) => ToTemplateValue (MS.Map k v) where
type TemplateRep (MS.Map k v) = Associative
toTemplateValue = toTemplateValue . AList . MS.toList
instance ToTemplateValue a => ToTemplateValue (Identity a) where
type TemplateRep (Identity a) = TemplateRep a
toTemplateValue = toTemplateValue . runIdentity
instance
( ToTemplateValue a, TemplateRep a ~ Single
, ToTemplateValue b, TemplateRep b ~ Single
) =>
ToTemplateValue (a, b) where
type TemplateRep (a, b) = List
toTemplateValue (a, b) = List
[ toTemplateValue a
, toTemplateValue b
]
instance
( ToTemplateValue a, TemplateRep a ~ Single
, ToTemplateValue b, TemplateRep b ~ Single
, ToTemplateValue c, TemplateRep c ~ Single
) =>
ToTemplateValue (a, b, c) where
type TemplateRep (a, b, c) = List
toTemplateValue (a, b, c) = List
[ toTemplateValue a
, toTemplateValue b
, toTemplateValue c
]
instance
( ToTemplateValue a, TemplateRep a ~ Single
, ToTemplateValue b, TemplateRep b ~ Single
, ToTemplateValue c, TemplateRep c ~ Single
, ToTemplateValue d, TemplateRep d ~ Single
) =>
ToTemplateValue (a, b, c, d) where
type TemplateRep (a, b, c, d) = List
toTemplateValue (a, b, c, d) = List
[ toTemplateValue a
, toTemplateValue b
, toTemplateValue c
, toTemplateValue d
]
instance
( ToTemplateValue a, TemplateRep a ~ Single
, ToTemplateValue b, TemplateRep b ~ Single
, ToTemplateValue c, TemplateRep c ~ Single
, ToTemplateValue d, TemplateRep d ~ Single
, ToTemplateValue e, TemplateRep e ~ Single
) =>
ToTemplateValue (a, b, c, d, e) where
type TemplateRep (a, b, c, d, e) = List
toTemplateValue (a, b, c, d, e) = List
[ toTemplateValue a
, toTemplateValue b
, toTemplateValue c
, toTemplateValue d
, toTemplateValue e
]
instance
( ToTemplateValue a, TemplateRep a ~ Single
, ToTemplateValue b, TemplateRep b ~ Single
, ToTemplateValue c, TemplateRep c ~ Single
, ToTemplateValue d, TemplateRep d ~ Single
, ToTemplateValue e, TemplateRep e ~ Single
, ToTemplateValue f, TemplateRep f ~ Single
) =>
ToTemplateValue (a, b, c, d, e, f) where
type TemplateRep (a, b, c, d, e, f) = List
toTemplateValue (a, b, c, d, e, f) = List
[ toTemplateValue a
, toTemplateValue b
, toTemplateValue c
, toTemplateValue d
, toTemplateValue e
, toTemplateValue f
]
instance
( ToTemplateValue a, TemplateRep a ~ Single
, ToTemplateValue b, TemplateRep b ~ Single
, ToTemplateValue c, TemplateRep c ~ Single
, ToTemplateValue d, TemplateRep d ~ Single
, ToTemplateValue e, TemplateRep e ~ Single
, ToTemplateValue f, TemplateRep f ~ Single
, ToTemplateValue g, TemplateRep g ~ Single
) =>
ToTemplateValue (a, b, c, d, e, f, g) where
type TemplateRep (a, b, c, d, e, f, g) = List
toTemplateValue (a, b, c, d, e, f, g) = List
[ toTemplateValue a
, toTemplateValue b
, toTemplateValue c
, toTemplateValue d
, toTemplateValue e
, toTemplateValue f
, toTemplateValue g
]
data ValueModifier
= Normal
| Explode
| MaxLength Int
deriving (Read, Show, Eq)
data Variable = Variable
{ variableName :: String
, variableValueModifier :: ValueModifier
} deriving (Read, Show, Eq)
data TemplateSegment
= Literal String
| Embed Modifier [Variable]
deriving (Read, Show, Eq)
type UriTemplate = [TemplateSegment]
data Modifier
= Simple
| Reserved
| Fragment
| Label
| PathSegment
| PathParameter
| Query
| QueryContinuation
deriving (Read, Show, Eq)