{-# LANGUAGE CPP                        #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveLift                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

module Data.API.Types
    ( API
    , Thing(..)
    , APINode(..)
    , TypeName(..)
    , FieldName(..)
    , MDComment
    , Prefix
    , Spec(..)
    , SpecNewtype(..)
    , SpecRecord(..)
    , FieldType(..)
    , SpecUnion(..)
    , SpecEnum(..)
    , Conversion
    , APIType(..)
    , DefaultValue(..)
    , BasicType(..)
    , Filter(..)
    , IntRange(..)
    , UTCRange(..)
    , RegEx(..)
    , Binary(..)
    , defaultValueAsJsValue
    , mkRegEx
    , inIntRange
    , inUTCRange
    , base64ToBinary
    ) where

import           Data.API.Time

import           Control.DeepSeq
import qualified Data.CaseInsensitive           as CI
import           Data.String
import           Data.Time
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Aeson.TH
import qualified Codec.Serialise     as CBOR
import           Data.Maybe
import           Data.SafeCopy
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as T
import qualified Data.ByteString.Char8          as B
import           Test.QuickCheck                as QC
import           Control.Applicative
import qualified Data.ByteString.Base64         as B64
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax
import           Text.Regex
import           Prelude


-- | an API spec is made up of a list of type/element specs, each
--   specifying a Haskell type and JSON wrappers

type API = [Thing]

data Thing
    = ThComment MDComment
    | ThNode    APINode
    deriving (Thing -> Thing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Thing -> Thing -> Bool
$c/= :: Thing -> Thing -> Bool
== :: Thing -> Thing -> Bool
$c== :: Thing -> Thing -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Thing -> m Exp
forall (m :: * -> *). Quote m => Thing -> Code m Thing
liftTyped :: forall (m :: * -> *). Quote m => Thing -> Code m Thing
$cliftTyped :: forall (m :: * -> *). Quote m => Thing -> Code m Thing
lift :: forall (m :: * -> *). Quote m => Thing -> m Exp
$clift :: forall (m :: * -> *). Quote m => Thing -> m Exp
Lift,Int -> Thing -> ShowS
[Thing] -> ShowS
Thing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thing] -> ShowS
$cshowList :: [Thing] -> ShowS
show :: Thing -> String
$cshow :: Thing -> String
showsPrec :: Int -> Thing -> ShowS
$cshowsPrec :: Int -> Thing -> ShowS
Show)

instance NFData Thing where
  rnf :: Thing -> ()
rnf (ThComment String
x) = forall a. NFData a => a -> ()
rnf String
x
  rnf (ThNode    APINode
x) = forall a. NFData a => a -> ()
rnf APINode
x

-- | Specifies an individual element/type of the API

data APINode
    = APINode
        { APINode -> TypeName
anName    :: TypeName         -- ^ name of Haskell type
        , APINode -> String
anComment :: MDComment        -- ^ comment describing type in Markdown
        , APINode -> Prefix
anPrefix  :: Prefix           -- ^ distinct short prefix (see below)
        , APINode -> Spec
anSpec    :: Spec             -- ^ the type specification
        , APINode -> Conversion
anConvert :: Conversion       -- ^ optional conversion functions
        }
    deriving (APINode -> APINode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: APINode -> APINode -> Bool
$c/= :: APINode -> APINode -> Bool
== :: APINode -> APINode -> Bool
$c== :: APINode -> APINode -> Bool
Eq,Int -> APINode -> ShowS
[APINode] -> ShowS
APINode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APINode] -> ShowS
$cshowList :: [APINode] -> ShowS
show :: APINode -> String
$cshow :: APINode -> String
showsPrec :: Int -> APINode -> ShowS
$cshowsPrec :: Int -> APINode -> ShowS
Show)

instance NFData APINode where
  rnf :: APINode -> ()
rnf (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = forall a. NFData a => a -> ()
rnf TypeName
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Prefix
c seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Spec
d seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Conversion
e

-- | TypeName must contain a valid Haskell type constructor
newtype TypeName = TypeName { TypeName -> Text
_TypeName :: T.Text }
    deriving (TypeName -> TypeName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c== :: TypeName -> TypeName -> Bool
Eq, Eq TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmax :: TypeName -> TypeName -> TypeName
>= :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c< :: TypeName -> TypeName -> Bool
compare :: TypeName -> TypeName -> Ordering
$ccompare :: TypeName -> TypeName -> Ordering
Ord, Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeName] -> ShowS
$cshowList :: [TypeName] -> ShowS
show :: TypeName -> String
$cshow :: TypeName -> String
showsPrec :: Int -> TypeName -> ShowS
$cshowsPrec :: Int -> TypeName -> ShowS
Show, TypeName -> ()
forall a. (a -> ()) -> NFData a
rnf :: TypeName -> ()
$crnf :: TypeName -> ()
NFData, String -> TypeName
forall a. (String -> a) -> IsString a
fromString :: String -> TypeName
$cfromString :: String -> TypeName
IsString)

-- | FieldName identifies recod fields and union alternatives
--   must contain a valid identifier valid in Haskell and
--   any API client wrappers (e.g., if Ruby wrappers are to be
--   generated the names should easily map into Ruby)
newtype FieldName = FieldName { FieldName -> Text
_FieldName :: T.Text }
    deriving (FieldName -> FieldName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c== :: FieldName -> FieldName -> Bool
Eq, Eq FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmax :: FieldName -> FieldName -> FieldName
>= :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c< :: FieldName -> FieldName -> Bool
compare :: FieldName -> FieldName -> Ordering
$ccompare :: FieldName -> FieldName -> Ordering
Ord, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> String
$cshow :: FieldName -> String
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show, FieldName -> ()
forall a. (a -> ()) -> NFData a
rnf :: FieldName -> ()
$crnf :: FieldName -> ()
NFData, String -> FieldName
forall a. (String -> a) -> IsString a
fromString :: String -> FieldName
$cfromString :: String -> FieldName
IsString)

-- | Markdown comments are represented by strings

type MDComment = String

-- | a distinct case-insensitive short prefix used to form unique record field
--   names and data constructors:
--
--      * must be a valid Haskell identifier
--
--      * must be unique within the API

type Prefix = CI.CI String

-- | type/element specs are either simple type isomorphisms of basic JSON
--   types, records, unions or enumerated types

data Spec
    = SpNewtype SpecNewtype
    | SpRecord  SpecRecord
    | SpUnion   SpecUnion
    | SpEnum    SpecEnum
    | SpSynonym APIType
    deriving (Spec -> Spec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spec -> Spec -> Bool
$c/= :: Spec -> Spec -> Bool
== :: Spec -> Spec -> Bool
$c== :: Spec -> Spec -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Spec -> m Exp
forall (m :: * -> *). Quote m => Spec -> Code m Spec
liftTyped :: forall (m :: * -> *). Quote m => Spec -> Code m Spec
$cliftTyped :: forall (m :: * -> *). Quote m => Spec -> Code m Spec
lift :: forall (m :: * -> *). Quote m => Spec -> m Exp
$clift :: forall (m :: * -> *). Quote m => Spec -> m Exp
Lift,Int -> Spec -> ShowS
[Spec] -> ShowS
Spec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spec] -> ShowS
$cshowList :: [Spec] -> ShowS
show :: Spec -> String
$cshow :: Spec -> String
showsPrec :: Int -> Spec -> ShowS
$cshowsPrec :: Int -> Spec -> ShowS
Show)

instance NFData Spec where
  rnf :: Spec -> ()
rnf (SpNewtype SpecNewtype
x) = forall a. NFData a => a -> ()
rnf SpecNewtype
x
  rnf (SpRecord  SpecRecord
x) = forall a. NFData a => a -> ()
rnf SpecRecord
x
  rnf (SpUnion   SpecUnion
x) = forall a. NFData a => a -> ()
rnf SpecUnion
x
  rnf (SpEnum    SpecEnum
x) = forall a. NFData a => a -> ()
rnf SpecEnum
x
  rnf (SpSynonym APIType
x) = forall a. NFData a => a -> ()
rnf APIType
x

-- | SpecNewtype elements are isomorphisms of string, inetgers or booleans

data SpecNewtype =
    SpecNewtype
        { SpecNewtype -> BasicType
snType   :: BasicType
        , SpecNewtype -> Maybe Filter
snFilter :: Maybe Filter
        }
    deriving (SpecNewtype -> SpecNewtype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecNewtype -> SpecNewtype -> Bool
$c/= :: SpecNewtype -> SpecNewtype -> Bool
== :: SpecNewtype -> SpecNewtype -> Bool
$c== :: SpecNewtype -> SpecNewtype -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecNewtype -> m Exp
forall (m :: * -> *). Quote m => SpecNewtype -> Code m SpecNewtype
liftTyped :: forall (m :: * -> *). Quote m => SpecNewtype -> Code m SpecNewtype
$cliftTyped :: forall (m :: * -> *). Quote m => SpecNewtype -> Code m SpecNewtype
lift :: forall (m :: * -> *). Quote m => SpecNewtype -> m Exp
$clift :: forall (m :: * -> *). Quote m => SpecNewtype -> m Exp
Lift,Int -> SpecNewtype -> ShowS
[SpecNewtype] -> ShowS
SpecNewtype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecNewtype] -> ShowS
$cshowList :: [SpecNewtype] -> ShowS
show :: SpecNewtype -> String
$cshow :: SpecNewtype -> String
showsPrec :: Int -> SpecNewtype -> ShowS
$cshowsPrec :: Int -> SpecNewtype -> ShowS
Show)

instance NFData SpecNewtype where
  rnf :: SpecNewtype -> ()
rnf (SpecNewtype BasicType
x Maybe Filter
y) = forall a. NFData a => a -> ()
rnf BasicType
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Filter
y

data Filter
    = FtrStrg RegEx
    | FtrIntg IntRange
    | FtrUTC  UTCRange
    deriving (Filter -> Filter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Filter -> m Exp
forall (m :: * -> *). Quote m => Filter -> Code m Filter
liftTyped :: forall (m :: * -> *). Quote m => Filter -> Code m Filter
$cliftTyped :: forall (m :: * -> *). Quote m => Filter -> Code m Filter
lift :: forall (m :: * -> *). Quote m => Filter -> m Exp
$clift :: forall (m :: * -> *). Quote m => Filter -> m Exp
Lift,Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show)

instance NFData Filter where
  rnf :: Filter -> ()
rnf (FtrStrg RegEx
x) = forall a. NFData a => a -> ()
rnf RegEx
x
  rnf (FtrIntg IntRange
x) = forall a. NFData a => a -> ()
rnf IntRange
x
  rnf (FtrUTC  UTCRange
x) = forall a. NFData a => a -> ()
rnf UTCRange
x

data IntRange
    = IntRange
        { IntRange -> Maybe Int
ir_lo :: Maybe Int
        , IntRange -> Maybe Int
ir_hi :: Maybe Int
        }
    deriving (IntRange -> IntRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntRange -> IntRange -> Bool
$c/= :: IntRange -> IntRange -> Bool
== :: IntRange -> IntRange -> Bool
$c== :: IntRange -> IntRange -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => IntRange -> m Exp
forall (m :: * -> *). Quote m => IntRange -> Code m IntRange
liftTyped :: forall (m :: * -> *). Quote m => IntRange -> Code m IntRange
$cliftTyped :: forall (m :: * -> *). Quote m => IntRange -> Code m IntRange
lift :: forall (m :: * -> *). Quote m => IntRange -> m Exp
$clift :: forall (m :: * -> *). Quote m => IntRange -> m Exp
Lift, Int -> IntRange -> ShowS
[IntRange] -> ShowS
IntRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntRange] -> ShowS
$cshowList :: [IntRange] -> ShowS
show :: IntRange -> String
$cshow :: IntRange -> String
showsPrec :: Int -> IntRange -> ShowS
$cshowsPrec :: Int -> IntRange -> ShowS
Show)

instance NFData IntRange where
  rnf :: IntRange -> ()
rnf (IntRange Maybe Int
x Maybe Int
y) = forall a. NFData a => a -> ()
rnf Maybe Int
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Int
y

inIntRange :: Int -> IntRange -> Bool
Int
_ inIntRange :: Int -> IntRange -> Bool
`inIntRange` IntRange Maybe Int
Nothing   Maybe Int
Nothing   = Bool
True
Int
i `inIntRange` IntRange (Just Int
lo) Maybe Int
Nothing   = Int
lo forall a. Ord a => a -> a -> Bool
<= Int
i
Int
i `inIntRange` IntRange Maybe Int
Nothing   (Just Int
hi) = Int
i forall a. Ord a => a -> a -> Bool
<= Int
hi
Int
i `inIntRange` IntRange (Just Int
lo) (Just Int
hi) = Int
lo forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= Int
hi

data UTCRange
    = UTCRange
        { UTCRange -> Maybe UTCTime
ur_lo :: Maybe UTCTime
        , UTCRange -> Maybe UTCTime
ur_hi :: Maybe UTCTime
        }
    deriving (UTCRange -> UTCRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTCRange -> UTCRange -> Bool
$c/= :: UTCRange -> UTCRange -> Bool
== :: UTCRange -> UTCRange -> Bool
$c== :: UTCRange -> UTCRange -> Bool
Eq, Int -> UTCRange -> ShowS
[UTCRange] -> ShowS
UTCRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTCRange] -> ShowS
$cshowList :: [UTCRange] -> ShowS
show :: UTCRange -> String
$cshow :: UTCRange -> String
showsPrec :: Int -> UTCRange -> ShowS
$cshowsPrec :: Int -> UTCRange -> ShowS
Show)

instance NFData UTCRange where
  rnf :: UTCRange -> ()
rnf (UTCRange Maybe UTCTime
x Maybe UTCTime
y) = forall a. NFData a => a -> ()
rnf Maybe UTCTime
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe UTCTime
y

inUTCRange :: UTCTime -> UTCRange -> Bool
UTCTime
_ inUTCRange :: UTCTime -> UTCRange -> Bool
`inUTCRange` UTCRange Maybe UTCTime
Nothing   Maybe UTCTime
Nothing   = Bool
True
UTCTime
u `inUTCRange` UTCRange (Just UTCTime
lo) Maybe UTCTime
Nothing   = UTCTime
lo forall a. Ord a => a -> a -> Bool
<= UTCTime
u
UTCTime
u `inUTCRange` UTCRange Maybe UTCTime
Nothing   (Just UTCTime
hi) = UTCTime
u forall a. Ord a => a -> a -> Bool
<= UTCTime
hi
UTCTime
u `inUTCRange` UTCRange (Just UTCTime
lo) (Just UTCTime
hi) = UTCTime
lo forall a. Ord a => a -> a -> Bool
<= UTCTime
u Bool -> Bool -> Bool
&& UTCTime
u forall a. Ord a => a -> a -> Bool
<= UTCTime
hi


data RegEx =
    RegEx
        { RegEx -> Text
re_text  :: T.Text
        , RegEx -> Regex
re_regex :: Regex
        }

mkRegEx :: T.Text -> RegEx
mkRegEx :: Text -> RegEx
mkRegEx Text
txt = Text -> Regex -> RegEx
RegEx Text
txt forall a b. (a -> b) -> a -> b
$ String -> Bool -> Bool -> Regex
mkRegexWithOpts (Text -> String
T.unpack Text
txt) Bool
False Bool
True

instance NFData RegEx where
  rnf :: RegEx -> ()
rnf (RegEx Text
x !Regex
_) = forall a. NFData a => a -> ()
rnf Text
x

instance ToJSON RegEx where
    toJSON :: RegEx -> Value
toJSON RegEx{Text
Regex
re_regex :: Regex
re_text :: Text
re_regex :: RegEx -> Regex
re_text :: RegEx -> Text
..} = Text -> Value
String Text
re_text

instance FromJSON RegEx where
    parseJSON :: Value -> Parser RegEx
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RegEx" (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RegEx
mkRegEx)

instance Eq RegEx where
    RegEx
r == :: RegEx -> RegEx -> Bool
== RegEx
s = RegEx -> Text
re_text RegEx
r forall a. Eq a => a -> a -> Bool
== RegEx -> Text
re_text RegEx
s

instance Show RegEx where
    show :: RegEx -> String
show = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegEx -> Text
re_text

-- | SpecRecord is your classsic product type.

data SpecRecord = SpecRecord
    { SpecRecord -> [(FieldName, FieldType)]
srFields :: [(FieldName, FieldType)]
    }
    deriving (SpecRecord -> SpecRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecRecord -> SpecRecord -> Bool
$c/= :: SpecRecord -> SpecRecord -> Bool
== :: SpecRecord -> SpecRecord -> Bool
$c== :: SpecRecord -> SpecRecord -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecRecord -> m Exp
forall (m :: * -> *). Quote m => SpecRecord -> Code m SpecRecord
liftTyped :: forall (m :: * -> *). Quote m => SpecRecord -> Code m SpecRecord
$cliftTyped :: forall (m :: * -> *). Quote m => SpecRecord -> Code m SpecRecord
lift :: forall (m :: * -> *). Quote m => SpecRecord -> m Exp
$clift :: forall (m :: * -> *). Quote m => SpecRecord -> m Exp
Lift,Int -> SpecRecord -> ShowS
[SpecRecord] -> ShowS
SpecRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecRecord] -> ShowS
$cshowList :: [SpecRecord] -> ShowS
show :: SpecRecord -> String
$cshow :: SpecRecord -> String
showsPrec :: Int -> SpecRecord -> ShowS
$cshowsPrec :: Int -> SpecRecord -> ShowS
Show)

instance NFData SpecRecord where
  rnf :: SpecRecord -> ()
rnf (SpecRecord [(FieldName, FieldType)]
x) = forall a. NFData a => a -> ()
rnf [(FieldName, FieldType)]
x

-- | In addition to the type and comment, record fields may carry a
-- flag indicating that they are read-only, and may have a default
-- value, which must be of a compatible type.

data FieldType = FieldType
    { FieldType -> APIType
ftType     :: APIType
    , FieldType -> Bool
ftReadOnly :: Bool
    , FieldType -> Maybe DefaultValue
ftDefault  :: Maybe DefaultValue
    , FieldType -> String
ftComment  :: MDComment
    }
    deriving (FieldType -> FieldType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c== :: FieldType -> FieldType -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FieldType -> m Exp
forall (m :: * -> *). Quote m => FieldType -> Code m FieldType
liftTyped :: forall (m :: * -> *). Quote m => FieldType -> Code m FieldType
$cliftTyped :: forall (m :: * -> *). Quote m => FieldType -> Code m FieldType
lift :: forall (m :: * -> *). Quote m => FieldType -> m Exp
$clift :: forall (m :: * -> *). Quote m => FieldType -> m Exp
Lift,Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldType] -> ShowS
$cshowList :: [FieldType] -> ShowS
show :: FieldType -> String
$cshow :: FieldType -> String
showsPrec :: Int -> FieldType -> ShowS
$cshowsPrec :: Int -> FieldType -> ShowS
Show)

instance NFData FieldType where
  rnf :: FieldType -> ()
rnf (FieldType APIType
a Bool
b Maybe DefaultValue
c String
d) = forall a. NFData a => a -> ()
rnf APIType
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Bool
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe DefaultValue
c seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
d

-- | SpecUnion is your classsic union type

data SpecUnion = SpecUnion
    { SpecUnion -> [(FieldName, (APIType, String))]
suFields :: [(FieldName,(APIType,MDComment))]
    }
    deriving (SpecUnion -> SpecUnion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecUnion -> SpecUnion -> Bool
$c/= :: SpecUnion -> SpecUnion -> Bool
== :: SpecUnion -> SpecUnion -> Bool
$c== :: SpecUnion -> SpecUnion -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecUnion -> m Exp
forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion
liftTyped :: forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion
$cliftTyped :: forall (m :: * -> *). Quote m => SpecUnion -> Code m SpecUnion
lift :: forall (m :: * -> *). Quote m => SpecUnion -> m Exp
$clift :: forall (m :: * -> *). Quote m => SpecUnion -> m Exp
Lift,Int -> SpecUnion -> ShowS
[SpecUnion] -> ShowS
SpecUnion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecUnion] -> ShowS
$cshowList :: [SpecUnion] -> ShowS
show :: SpecUnion -> String
$cshow :: SpecUnion -> String
showsPrec :: Int -> SpecUnion -> ShowS
$cshowsPrec :: Int -> SpecUnion -> ShowS
Show)

instance NFData SpecUnion where
  rnf :: SpecUnion -> ()
rnf (SpecUnion [(FieldName, (APIType, String))]
x) = forall a. NFData a => a -> ()
rnf [(FieldName, (APIType, String))]
x

-- | SpecEnum is your classic enumerated type

data SpecEnum = SpecEnum
    { SpecEnum -> [(FieldName, String)]
seAlts :: [(FieldName,MDComment)]
    }
    deriving (SpecEnum -> SpecEnum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecEnum -> SpecEnum -> Bool
$c/= :: SpecEnum -> SpecEnum -> Bool
== :: SpecEnum -> SpecEnum -> Bool
$c== :: SpecEnum -> SpecEnum -> Bool
Eq,forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SpecEnum -> m Exp
forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum
liftTyped :: forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum
$cliftTyped :: forall (m :: * -> *). Quote m => SpecEnum -> Code m SpecEnum
lift :: forall (m :: * -> *). Quote m => SpecEnum -> m Exp
$clift :: forall (m :: * -> *). Quote m => SpecEnum -> m Exp
Lift,Int -> SpecEnum -> ShowS
[SpecEnum] -> ShowS
SpecEnum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecEnum] -> ShowS
$cshowList :: [SpecEnum] -> ShowS
show :: SpecEnum -> String
$cshow :: SpecEnum -> String
showsPrec :: Int -> SpecEnum -> ShowS
$cshowsPrec :: Int -> SpecEnum -> ShowS
Show)

instance NFData SpecEnum where
  rnf :: SpecEnum -> ()
rnf (SpecEnum [(FieldName, String)]
x) = forall a. NFData a => a -> ()
rnf [(FieldName, String)]
x

-- | Conversion possibly converts to an internal representation.  If
-- specified, a conversion is a pair of an injection function name and
-- a projection function name.
type Conversion = Maybe (FieldName,FieldName)

-- | Type is either a list, Maybe, a named element of the API or a basic type
data APIType
    = TyList  APIType       -- ^ list elements are types
    | TyMaybe APIType       -- ^ Maybe elements are types
    | TyName  TypeName      -- ^ the referenced type must be defined by the API
    | TyBasic BasicType     -- ^ a JSON string, int, bool etc.
    | TyJSON                -- ^ a generic JSON value
    deriving (APIType -> APIType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: APIType -> APIType -> Bool
$c/= :: APIType -> APIType -> Bool
== :: APIType -> APIType -> Bool
$c== :: APIType -> APIType -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => APIType -> m Exp
forall (m :: * -> *). Quote m => APIType -> Code m APIType
liftTyped :: forall (m :: * -> *). Quote m => APIType -> Code m APIType
$cliftTyped :: forall (m :: * -> *). Quote m => APIType -> Code m APIType
lift :: forall (m :: * -> *). Quote m => APIType -> m Exp
$clift :: forall (m :: * -> *). Quote m => APIType -> m Exp
Lift, Int -> APIType -> ShowS
[APIType] -> ShowS
APIType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APIType] -> ShowS
$cshowList :: [APIType] -> ShowS
show :: APIType -> String
$cshow :: APIType -> String
showsPrec :: Int -> APIType -> ShowS
$cshowsPrec :: Int -> APIType -> ShowS
Show)

-- | It is sometimes helpful to write a type name directly as a string
instance IsString APIType where
  fromString :: String -> APIType
fromString = TypeName -> APIType
TyName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance NFData APIType where
  rnf :: APIType -> ()
rnf (TyList  APIType
ty) = forall a. NFData a => a -> ()
rnf APIType
ty
  rnf (TyMaybe APIType
ty) = forall a. NFData a => a -> ()
rnf APIType
ty
  rnf (TyName  TypeName
tn) = forall a. NFData a => a -> ()
rnf TypeName
tn
  rnf (TyBasic BasicType
bt) = forall a. NFData a => a -> ()
rnf BasicType
bt
  rnf APIType
TyJSON       = ()

-- | the basic JSON types (N.B., no floating point numbers, yet)
data BasicType
    = BTstring -- ^ a JSON UTF-8 string
    | BTbinary -- ^ a base-64-encoded byte string
    | BTbool   -- ^ a JSON bool
    | BTint    -- ^ a JSON integral number
    | BTutc    -- ^ a JSON UTC string
    deriving (BasicType -> BasicType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicType -> BasicType -> Bool
$c/= :: BasicType -> BasicType -> Bool
== :: BasicType -> BasicType -> Bool
$c== :: BasicType -> BasicType -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => BasicType -> m Exp
forall (m :: * -> *). Quote m => BasicType -> Code m BasicType
liftTyped :: forall (m :: * -> *). Quote m => BasicType -> Code m BasicType
$cliftTyped :: forall (m :: * -> *). Quote m => BasicType -> Code m BasicType
lift :: forall (m :: * -> *). Quote m => BasicType -> m Exp
$clift :: forall (m :: * -> *). Quote m => BasicType -> m Exp
Lift, Int -> BasicType -> ShowS
[BasicType] -> ShowS
BasicType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicType] -> ShowS
$cshowList :: [BasicType] -> ShowS
show :: BasicType -> String
$cshow :: BasicType -> String
showsPrec :: Int -> BasicType -> ShowS
$cshowsPrec :: Int -> BasicType -> ShowS
Show)

instance NFData BasicType where
  rnf :: BasicType -> ()
rnf !BasicType
_ = ()

-- | A default value for a field
data DefaultValue
    = DefValList
    | DefValMaybe
    | DefValString T.Text  -- used for binary fields (base64 encoded)
    | DefValBool   Bool
    | DefValInt    Int
    | DefValUtc    UTCTime
    deriving (DefaultValue -> DefaultValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultValue -> DefaultValue -> Bool
$c/= :: DefaultValue -> DefaultValue -> Bool
== :: DefaultValue -> DefaultValue -> Bool
$c== :: DefaultValue -> DefaultValue -> Bool
Eq, Int -> DefaultValue -> ShowS
[DefaultValue] -> ShowS
DefaultValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultValue] -> ShowS
$cshowList :: [DefaultValue] -> ShowS
show :: DefaultValue -> String
$cshow :: DefaultValue -> String
showsPrec :: Int -> DefaultValue -> ShowS
$cshowsPrec :: Int -> DefaultValue -> ShowS
Show)

instance NFData DefaultValue where
  rnf :: DefaultValue -> ()
rnf DefaultValue
DefValList       = ()
  rnf DefaultValue
DefValMaybe      = ()
  rnf (DefValString Text
t) = forall a. NFData a => a -> ()
rnf Text
t
  rnf (DefValBool   Bool
b) = forall a. NFData a => a -> ()
rnf Bool
b
  rnf (DefValInt    Int
i) = forall a. NFData a => a -> ()
rnf Int
i
  rnf (DefValUtc    UTCTime
u) = forall a. NFData a => a -> ()
rnf UTCTime
u

-- | Convert a default value to an Aeson 'Value'.  This differs from
-- 'toJSON' as it will not round-trip with 'fromJSON': UTC default
-- values are turned into strings.
defaultValueAsJsValue :: DefaultValue -> Value
defaultValueAsJsValue :: DefaultValue -> Value
defaultValueAsJsValue  DefaultValue
DefValList                = forall a. ToJSON a => a -> Value
toJSON ([] :: [()])
defaultValueAsJsValue  DefaultValue
DefValMaybe               = Value
Null
defaultValueAsJsValue (DefValString Text
s)           = Text -> Value
String Text
s
defaultValueAsJsValue (DefValBool   Bool
b)           = Bool -> Value
Bool Bool
b
defaultValueAsJsValue (DefValInt    Int
n)           = Scientific -> Value
Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
defaultValueAsJsValue (DefValUtc    UTCTime
t)           = Text -> Value
String (UTCTime -> Text
printUTC UTCTime
t)


-- | Binary data is represented in JSON format as a base64-encoded
-- string
newtype Binary = Binary { Binary -> ByteString
_Binary :: B.ByteString }
    deriving (Int -> Binary -> ShowS
[Binary] -> ShowS
Binary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binary] -> ShowS
$cshowList :: [Binary] -> ShowS
show :: Binary -> String
$cshow :: Binary -> String
showsPrec :: Int -> Binary -> ShowS
$cshowsPrec :: Int -> Binary -> ShowS
Show,Binary -> Binary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binary -> Binary -> Bool
$c/= :: Binary -> Binary -> Bool
== :: Binary -> Binary -> Bool
$c== :: Binary -> Binary -> Bool
Eq,Eq Binary
Binary -> Binary -> Bool
Binary -> Binary -> Ordering
Binary -> Binary -> Binary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Binary -> Binary -> Binary
$cmin :: Binary -> Binary -> Binary
max :: Binary -> Binary -> Binary
$cmax :: Binary -> Binary -> Binary
>= :: Binary -> Binary -> Bool
$c>= :: Binary -> Binary -> Bool
> :: Binary -> Binary -> Bool
$c> :: Binary -> Binary -> Bool
<= :: Binary -> Binary -> Bool
$c<= :: Binary -> Binary -> Bool
< :: Binary -> Binary -> Bool
$c< :: Binary -> Binary -> Bool
compare :: Binary -> Binary -> Ordering
$ccompare :: Binary -> Binary -> Ordering
Ord,Binary -> ()
forall a. (a -> ()) -> NFData a
rnf :: Binary -> ()
$crnf :: Binary -> ()
NFData,[Binary] -> Encoding
Binary -> Encoding
forall s. Decoder s [Binary]
forall s. Decoder s Binary
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [Binary]
$cdecodeList :: forall s. Decoder s [Binary]
encodeList :: [Binary] -> Encoding
$cencodeList :: [Binary] -> Encoding
decode :: forall s. Decoder s Binary
$cdecode :: forall s. Decoder s Binary
encode :: Binary -> Encoding
$cencode :: Binary -> Encoding
CBOR.Serialise)

instance ToJSON Binary where
    toJSON :: Binary -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> ByteString
_Binary

instance FromJSON Binary where
    parseJSON :: Value -> Parser Binary
parseJSON = forall a. String -> (Binary -> Parser a) -> Value -> Parser a
withBinary String
"Binary" forall (m :: * -> *) a. Monad m => a -> m a
return

instance QC.Arbitrary T.Text where
    arbitrary :: Gen Text
arbitrary = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary

instance QC.Arbitrary Binary where
    arbitrary :: Gen Binary
arbitrary = ByteString -> Binary
Binary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ByteString
B.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary

withBinary :: String -> (Binary->Parser a) -> Value -> Parser a
withBinary :: forall a. String -> (Binary -> Parser a) -> Value -> Parser a
withBinary String
lab Binary -> Parser a
f = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
lab Text -> Parser a
g
  where
    g :: Text -> Parser a
g Text
t =
        case Text -> Either String Binary
base64ToBinary Text
t of
          Left  String
_  -> forall a. String -> Value -> Parser a
typeMismatch String
lab (Text -> Value
String Text
t)
          Right Binary
bs -> Binary -> Parser a
f Binary
bs

base64ToBinary :: T.Text -> Either String Binary
base64ToBinary :: Text -> Either String Binary
base64ToBinary Text
t = ByteString -> Binary
Binary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ByteString
B64.decode (Text -> ByteString
T.encodeUtf8 Text
t)


instance Lift APINode where
  lift :: forall (m :: * -> *). Quote m => APINode -> m Exp
lift (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = [e| APINode a b $(liftPrefix c) d e |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => APINode -> Code m APINode
liftTyped (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = [e|| APINode a b $$(liftTypedPrefix c) d e ||]
#endif


#if MIN_VERSION_template_haskell(2,17,0)
liftPrefix :: Quote m => Prefix -> m Exp
liftText :: Quote m => T.Text -> m Exp
liftUTC :: Quote m => UTCTime -> m Exp
liftMaybeUTCTime :: Quote m => Maybe UTCTime -> m Exp
#else
liftPrefix :: Prefix -> ExpQ
liftText :: T.Text -> ExpQ
liftUTC :: UTCTime -> ExpQ
liftMaybeUTCTime :: Maybe UTCTime -> ExpQ
#endif

liftPrefix :: forall (m :: * -> *). Quote m => Prefix -> m Exp
liftPrefix Prefix
ci = let s :: String
s = forall s. CI s -> s
CI.original Prefix
ci in [e| CI.mk s |]

liftText :: forall (m :: * -> *). Quote m => Text -> m Exp
liftText Text
s = [e| T.pack $(litE (stringL (T.unpack s))) |]

liftUTC :: forall (m :: * -> *). Quote m => UTCTime -> m Exp
liftUTC UTCTime
u = [e| unsafeParseUTC $(liftText (printUTC u)) |]

liftMaybeUTCTime :: forall (m :: * -> *). Quote m => Maybe UTCTime -> m Exp
liftMaybeUTCTime Maybe UTCTime
Nothing  = [e| Nothing |]
liftMaybeUTCTime (Just UTCTime
u) = [e| Just $(liftUTC u) |]



#if MIN_VERSION_template_haskell(2,17,0)
liftTypedPrefix :: Quote m => Prefix -> Code m Prefix
liftTypedPrefix :: forall (m :: * -> *). Quote m => Prefix -> Code m Prefix
liftTypedPrefix Prefix
ci = let s :: String
s = forall s. CI s -> s
CI.original Prefix
ci in [e|| CI.mk s ||]

liftTypedText :: Quote m => T.Text -> Code m T.Text
liftTypedText :: forall (m :: * -> *). Quote m => Text -> Code m Text
liftTypedText Text
s = [e|| T.pack $$(liftTyped (T.unpack s)) ||]

liftTypedUTC :: Quote m => UTCTime -> Code m UTCTime
liftTypedUTC :: forall (m :: * -> *). Quote m => UTCTime -> Code m UTCTime
liftTypedUTC UTCTime
u = [e|| unsafeParseUTC $$(liftTypedText (printUTC u)) ||]

liftTypedMaybeUTCTime :: Quote m => Maybe UTCTime -> Code m (Maybe UTCTime)
liftTypedMaybeUTCTime :: forall (m :: * -> *).
Quote m =>
Maybe UTCTime -> Code m (Maybe UTCTime)
liftTypedMaybeUTCTime Maybe UTCTime
Nothing  = [e|| Nothing ||]
liftTypedMaybeUTCTime (Just UTCTime
u) = [e|| Just $$(liftTypedUTC u) ||]
#elif MIN_VERSION_template_haskell(2,16,0)
liftTypedPrefix :: Prefix -> TExpQ Prefix
liftTypedPrefix ci = let s = CI.original ci in [e|| CI.mk s ||]

liftTypedText :: T.Text -> TExpQ T.Text
liftTypedText s = [e|| T.pack $$(liftTyped (T.unpack s)) ||]

liftTypedUTC :: UTCTime -> TExpQ UTCTime
liftTypedUTC u = [e|| unsafeParseUTC $$(liftTypedText (printUTC u)) ||]

liftTypedMaybeUTCTime :: Maybe UTCTime -> TExpQ (Maybe UTCTime)
liftTypedMaybeUTCTime Nothing  = [e|| Nothing ||]
liftTypedMaybeUTCTime (Just u) = [e|| Just $$(liftTypedUTC u) ||]
#endif

instance Lift TypeName where
  lift :: forall (m :: * -> *). Quote m => TypeName -> m Exp
lift (TypeName Text
s) = [e| TypeName $(liftText s) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => TypeName -> Code m TypeName
liftTyped (TypeName Text
s) = [e|| TypeName $$(liftTypedText s) ||]
#endif

instance Lift FieldName where
  lift :: forall (m :: * -> *). Quote m => FieldName -> m Exp
lift (FieldName Text
s) = [e| FieldName $(liftText s) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => FieldName -> Code m FieldName
liftTyped (FieldName Text
s) = [e|| FieldName $$(liftTypedText s) ||]
#endif

instance Lift UTCRange where
  lift :: forall (m :: * -> *). Quote m => UTCRange -> m Exp
lift (UTCRange Maybe UTCTime
lo Maybe UTCTime
hi) = [e| UTCRange $(liftMaybeUTCTime lo) $(liftMaybeUTCTime hi) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => UTCRange -> Code m UTCRange
liftTyped (UTCRange Maybe UTCTime
lo Maybe UTCTime
hi) = [e|| UTCRange $$(liftTypedMaybeUTCTime lo) $$(liftTypedMaybeUTCTime hi) ||]
#endif

instance Lift RegEx where
  lift :: forall (m :: * -> *). Quote m => RegEx -> m Exp
lift RegEx
re = [e| mkRegEx $(liftText (re_text re)) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => RegEx -> Code m RegEx
liftTyped RegEx
re = [e|| mkRegEx $$(liftTypedText (re_text re)) ||]
#endif

instance Lift DefaultValue where
  lift :: forall (m :: * -> *). Quote m => DefaultValue -> m Exp
lift DefaultValue
DefValList       = [e| DefValList |]
  lift DefaultValue
DefValMaybe      = [e| DefValMaybe |]
  lift (DefValString Text
s) = [e| DefValString $(liftText s) |]
  lift (DefValBool   Bool
b) = [e| DefValBool b |]
  lift (DefValInt    Int
i) = [e| DefValInt i |]
  lift (DefValUtc    UTCTime
u) = [e| DefValUtc $(liftUTC u) |]

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
DefaultValue -> Code m DefaultValue
liftTyped DefaultValue
DefValList       = [e|| DefValList ||]
  liftTyped DefaultValue
DefValMaybe      = [e|| DefValMaybe ||]
  liftTyped (DefValString Text
s) = [e|| DefValString $$(liftTypedText s) ||]
  liftTyped (DefValBool   Bool
b) = [e|| DefValBool b ||]
  liftTyped (DefValInt    Int
i) = [e|| DefValInt i ||]
  liftTyped (DefValUtc    UTCTime
u) = [e|| DefValUtc $$(liftTypedUTC u) ||]
#endif

$(deriveSafeCopy 0 'base ''Binary)

$(let deriveJSONs = fmap concat . mapM (deriveJSON defaultOptions)
  in deriveJSONs [ ''CI.CI
                 , ''TypeName
                 , ''FieldName
                 , ''DefaultValue
                 , ''SpecEnum
                 , ''SpecUnion
                 , ''SpecRecord
                 , ''FieldType
                 , ''SpecNewtype
                 , ''Filter
                 , ''IntRange
                 , ''UTCRange
                 , ''BasicType
                 , ''APIType
                 , ''Spec
                 , ''APINode
                 , ''Thing
                 ])