{-# 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
(Thing -> Thing -> Bool) -> (Thing -> Thing -> Bool) -> Eq Thing
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,Thing -> Q Exp
Thing -> Q (TExp Thing)
(Thing -> Q Exp) -> (Thing -> Q (TExp Thing)) -> Lift Thing
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Thing -> Q (TExp Thing)
$cliftTyped :: Thing -> Q (TExp Thing)
lift :: Thing -> Q Exp
$clift :: Thing -> Q Exp
Lift,Int -> Thing -> ShowS
[Thing] -> ShowS
Thing -> String
(Int -> Thing -> ShowS)
-> (Thing -> String) -> ([Thing] -> ShowS) -> Show Thing
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) = String -> ()
forall a. NFData a => a -> ()
rnf String
x
  rnf (ThNode    APINode
x) = APINode -> ()
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
(APINode -> APINode -> Bool)
-> (APINode -> APINode -> Bool) -> Eq APINode
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
(Int -> APINode -> ShowS)
-> (APINode -> String) -> ([APINode] -> ShowS) -> Show APINode
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) = TypeName -> ()
forall a. NFData a => a -> ()
rnf TypeName
a () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
b () -> () -> ()
`seq` Prefix -> ()
forall a. NFData a => a -> ()
rnf Prefix
c () -> () -> ()
`seq` Spec -> ()
forall a. NFData a => a -> ()
rnf Spec
d () -> () -> ()
`seq` Conversion -> ()
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
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
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
Eq TypeName
-> (TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord 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
$cp1Ord :: Eq TypeName
Ord, Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
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 -> ()
(TypeName -> ()) -> NFData TypeName
forall a. (a -> ()) -> NFData a
rnf :: TypeName -> ()
$crnf :: TypeName -> ()
NFData, String -> TypeName
(String -> TypeName) -> IsString 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
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
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
Eq FieldName
-> (FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord 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
$cp1Ord :: Eq FieldName
Ord, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
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 -> ()
(FieldName -> ()) -> NFData FieldName
forall a. (a -> ()) -> NFData a
rnf :: FieldName -> ()
$crnf :: FieldName -> ()
NFData, String -> FieldName
(String -> FieldName) -> IsString 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
(Spec -> Spec -> Bool) -> (Spec -> Spec -> Bool) -> Eq Spec
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,Spec -> Q Exp
Spec -> Q (TExp Spec)
(Spec -> Q Exp) -> (Spec -> Q (TExp Spec)) -> Lift Spec
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Spec -> Q (TExp Spec)
$cliftTyped :: Spec -> Q (TExp Spec)
lift :: Spec -> Q Exp
$clift :: Spec -> Q Exp
Lift,Int -> Spec -> ShowS
[Spec] -> ShowS
Spec -> String
(Int -> Spec -> ShowS)
-> (Spec -> String) -> ([Spec] -> ShowS) -> Show Spec
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) = SpecNewtype -> ()
forall a. NFData a => a -> ()
rnf SpecNewtype
x
  rnf (SpRecord  SpecRecord
x) = SpecRecord -> ()
forall a. NFData a => a -> ()
rnf SpecRecord
x
  rnf (SpUnion   SpecUnion
x) = SpecUnion -> ()
forall a. NFData a => a -> ()
rnf SpecUnion
x
  rnf (SpEnum    SpecEnum
x) = SpecEnum -> ()
forall a. NFData a => a -> ()
rnf SpecEnum
x
  rnf (SpSynonym APIType
x) = APIType -> ()
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
(SpecNewtype -> SpecNewtype -> Bool)
-> (SpecNewtype -> SpecNewtype -> Bool) -> Eq SpecNewtype
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,SpecNewtype -> Q Exp
SpecNewtype -> Q (TExp SpecNewtype)
(SpecNewtype -> Q Exp)
-> (SpecNewtype -> Q (TExp SpecNewtype)) -> Lift SpecNewtype
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SpecNewtype -> Q (TExp SpecNewtype)
$cliftTyped :: SpecNewtype -> Q (TExp SpecNewtype)
lift :: SpecNewtype -> Q Exp
$clift :: SpecNewtype -> Q Exp
Lift,Int -> SpecNewtype -> ShowS
[SpecNewtype] -> ShowS
SpecNewtype -> String
(Int -> SpecNewtype -> ShowS)
-> (SpecNewtype -> String)
-> ([SpecNewtype] -> ShowS)
-> Show SpecNewtype
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) = BasicType -> ()
forall a. NFData a => a -> ()
rnf BasicType
x () -> () -> ()
`seq` Maybe Filter -> ()
forall a. NFData a => a -> ()
rnf Maybe Filter
y

data Filter
    = FtrStrg RegEx
    | FtrIntg IntRange
    | FtrUTC  UTCRange
    deriving (Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
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,Filter -> Q Exp
Filter -> Q (TExp Filter)
(Filter -> Q Exp) -> (Filter -> Q (TExp Filter)) -> Lift Filter
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Filter -> Q (TExp Filter)
$cliftTyped :: Filter -> Q (TExp Filter)
lift :: Filter -> Q Exp
$clift :: Filter -> Q Exp
Lift,Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
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) = RegEx -> ()
forall a. NFData a => a -> ()
rnf RegEx
x
  rnf (FtrIntg IntRange
x) = IntRange -> ()
forall a. NFData a => a -> ()
rnf IntRange
x
  rnf (FtrUTC  UTCRange
x) = UTCRange -> ()
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
(IntRange -> IntRange -> Bool)
-> (IntRange -> IntRange -> Bool) -> Eq IntRange
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, IntRange -> Q Exp
IntRange -> Q (TExp IntRange)
(IntRange -> Q Exp)
-> (IntRange -> Q (TExp IntRange)) -> Lift IntRange
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: IntRange -> Q (TExp IntRange)
$cliftTyped :: IntRange -> Q (TExp IntRange)
lift :: IntRange -> Q Exp
$clift :: IntRange -> Q Exp
Lift, Int -> IntRange -> ShowS
[IntRange] -> ShowS
IntRange -> String
(Int -> IntRange -> ShowS)
-> (IntRange -> String) -> ([IntRange] -> ShowS) -> Show IntRange
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) = Maybe Int -> ()
forall a. NFData a => a -> ()
rnf Maybe Int
x () -> () -> ()
`seq` Maybe Int -> ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i
Int
i `inIntRange` IntRange Maybe Int
Nothing   (Just Int
hi) = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi
Int
i `inIntRange` IntRange (Just Int
lo) (Just Int
hi) = Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
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
(UTCRange -> UTCRange -> Bool)
-> (UTCRange -> UTCRange -> Bool) -> Eq UTCRange
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
(Int -> UTCRange -> ShowS)
-> (UTCRange -> String) -> ([UTCRange] -> ShowS) -> Show UTCRange
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) = Maybe UTCTime -> ()
forall a. NFData a => a -> ()
rnf Maybe UTCTime
x () -> () -> ()
`seq` Maybe UTCTime -> ()
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 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
u
UTCTime
u `inUTCRange` UTCRange Maybe UTCTime
Nothing   (Just UTCTime
hi) = UTCTime
u UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
hi
UTCTime
u `inUTCRange` UTCRange (Just UTCTime
lo) (Just UTCTime
hi) = UTCTime
lo UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
u Bool -> Bool -> Bool
&& UTCTime
u UTCTime -> UTCTime -> Bool
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 (Regex -> RegEx) -> Regex -> RegEx
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
_) = Text -> ()
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 = String -> (Text -> Parser RegEx) -> Value -> Parser RegEx
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RegEx" (RegEx -> Parser RegEx
forall (m :: * -> *) a. Monad m => a -> m a
return (RegEx -> Parser RegEx) -> (Text -> RegEx) -> Text -> Parser RegEx
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 Text -> Text -> Bool
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 (Text -> String) -> (RegEx -> Text) -> RegEx -> String
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
(SpecRecord -> SpecRecord -> Bool)
-> (SpecRecord -> SpecRecord -> Bool) -> Eq SpecRecord
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,SpecRecord -> Q Exp
SpecRecord -> Q (TExp SpecRecord)
(SpecRecord -> Q Exp)
-> (SpecRecord -> Q (TExp SpecRecord)) -> Lift SpecRecord
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SpecRecord -> Q (TExp SpecRecord)
$cliftTyped :: SpecRecord -> Q (TExp SpecRecord)
lift :: SpecRecord -> Q Exp
$clift :: SpecRecord -> Q Exp
Lift,Int -> SpecRecord -> ShowS
[SpecRecord] -> ShowS
SpecRecord -> String
(Int -> SpecRecord -> ShowS)
-> (SpecRecord -> String)
-> ([SpecRecord] -> ShowS)
-> Show SpecRecord
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) = [(FieldName, FieldType)] -> ()
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
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
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,FieldType -> Q Exp
FieldType -> Q (TExp FieldType)
(FieldType -> Q Exp)
-> (FieldType -> Q (TExp FieldType)) -> Lift FieldType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FieldType -> Q (TExp FieldType)
$cliftTyped :: FieldType -> Q (TExp FieldType)
lift :: FieldType -> Q Exp
$clift :: FieldType -> Q Exp
Lift,Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
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) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
a () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b () -> () -> ()
`seq` Maybe DefaultValue -> ()
forall a. NFData a => a -> ()
rnf Maybe DefaultValue
c () -> () -> ()
`seq` String -> ()
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
(SpecUnion -> SpecUnion -> Bool)
-> (SpecUnion -> SpecUnion -> Bool) -> Eq SpecUnion
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,SpecUnion -> Q Exp
SpecUnion -> Q (TExp SpecUnion)
(SpecUnion -> Q Exp)
-> (SpecUnion -> Q (TExp SpecUnion)) -> Lift SpecUnion
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SpecUnion -> Q (TExp SpecUnion)
$cliftTyped :: SpecUnion -> Q (TExp SpecUnion)
lift :: SpecUnion -> Q Exp
$clift :: SpecUnion -> Q Exp
Lift,Int -> SpecUnion -> ShowS
[SpecUnion] -> ShowS
SpecUnion -> String
(Int -> SpecUnion -> ShowS)
-> (SpecUnion -> String)
-> ([SpecUnion] -> ShowS)
-> Show SpecUnion
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) = [(FieldName, (APIType, String))] -> ()
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
(SpecEnum -> SpecEnum -> Bool)
-> (SpecEnum -> SpecEnum -> Bool) -> Eq SpecEnum
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,SpecEnum -> Q Exp
SpecEnum -> Q (TExp SpecEnum)
(SpecEnum -> Q Exp)
-> (SpecEnum -> Q (TExp SpecEnum)) -> Lift SpecEnum
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SpecEnum -> Q (TExp SpecEnum)
$cliftTyped :: SpecEnum -> Q (TExp SpecEnum)
lift :: SpecEnum -> Q Exp
$clift :: SpecEnum -> Q Exp
Lift,Int -> SpecEnum -> ShowS
[SpecEnum] -> ShowS
SpecEnum -> String
(Int -> SpecEnum -> ShowS)
-> (SpecEnum -> String) -> ([SpecEnum] -> ShowS) -> Show SpecEnum
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) = [(FieldName, String)] -> ()
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
(APIType -> APIType -> Bool)
-> (APIType -> APIType -> Bool) -> Eq APIType
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, APIType -> Q Exp
APIType -> Q (TExp APIType)
(APIType -> Q Exp) -> (APIType -> Q (TExp APIType)) -> Lift APIType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: APIType -> Q (TExp APIType)
$cliftTyped :: APIType -> Q (TExp APIType)
lift :: APIType -> Q Exp
$clift :: APIType -> Q Exp
Lift, Int -> APIType -> ShowS
[APIType] -> ShowS
APIType -> String
(Int -> APIType -> ShowS)
-> (APIType -> String) -> ([APIType] -> ShowS) -> Show APIType
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 (TypeName -> APIType) -> (String -> TypeName) -> String -> APIType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TypeName
forall a. IsString a => String -> a
fromString

instance NFData APIType where
  rnf :: APIType -> ()
rnf (TyList  APIType
ty) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
ty
  rnf (TyMaybe APIType
ty) = APIType -> ()
forall a. NFData a => a -> ()
rnf APIType
ty
  rnf (TyName  TypeName
tn) = TypeName -> ()
forall a. NFData a => a -> ()
rnf TypeName
tn
  rnf (TyBasic BasicType
bt) = BasicType -> ()
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
(BasicType -> BasicType -> Bool)
-> (BasicType -> BasicType -> Bool) -> Eq BasicType
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, BasicType -> Q Exp
BasicType -> Q (TExp BasicType)
(BasicType -> Q Exp)
-> (BasicType -> Q (TExp BasicType)) -> Lift BasicType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: BasicType -> Q (TExp BasicType)
$cliftTyped :: BasicType -> Q (TExp BasicType)
lift :: BasicType -> Q Exp
$clift :: BasicType -> Q Exp
Lift, Int -> BasicType -> ShowS
[BasicType] -> ShowS
BasicType -> String
(Int -> BasicType -> ShowS)
-> (BasicType -> String)
-> ([BasicType] -> ShowS)
-> Show BasicType
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
(DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool) -> Eq DefaultValue
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
(Int -> DefaultValue -> ShowS)
-> (DefaultValue -> String)
-> ([DefaultValue] -> ShowS)
-> Show DefaultValue
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) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t
  rnf (DefValBool   Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
  rnf (DefValInt    Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
  rnf (DefValUtc    UTCTime
u) = UTCTime -> ()
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                = [()] -> Value
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 (Int -> Scientific
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
(Int -> Binary -> ShowS)
-> (Binary -> String) -> ([Binary] -> ShowS) -> Show Binary
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
(Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool) -> Eq Binary
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
Eq Binary
-> (Binary -> Binary -> Ordering)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Binary)
-> (Binary -> Binary -> Binary)
-> Ord 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
$cp1Ord :: Eq Binary
Ord,Binary -> ()
(Binary -> ()) -> NFData Binary
forall a. (a -> ()) -> NFData a
rnf :: Binary -> ()
$crnf :: Binary -> ()
NFData,Decoder s Binary
Decoder s [Binary]
[Binary] -> Encoding
Binary -> Encoding
(Binary -> Encoding)
-> (forall s. Decoder s Binary)
-> ([Binary] -> Encoding)
-> (forall s. Decoder s [Binary])
-> Serialise Binary
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 :: Decoder s [Binary]
$cdecodeList :: forall s. Decoder s [Binary]
encodeList :: [Binary] -> Encoding
$cencodeList :: [Binary] -> Encoding
decode :: 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 (Text -> Value) -> (Binary -> Text) -> Binary -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (Binary -> ByteString) -> Binary -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (Binary -> ByteString) -> Binary -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> ByteString
_Binary

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

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

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

withBinary :: String -> (Binary->Parser a) -> Value -> Parser a
withBinary :: String -> (Binary -> Parser a) -> Value -> Parser a
withBinary String
lab Binary -> Parser a
f = String -> (Text -> Parser a) -> Value -> Parser a
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
_  -> String -> Value -> Parser a
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 (ByteString -> Binary)
-> Either String ByteString -> Either String 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 :: APINode -> Q 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 :: APINode -> Q (TExp APINode)
liftTyped (APINode TypeName
a String
b Prefix
c Spec
d Conversion
e) = [e|| APINode a b $$(liftTypedPrefix c) d e ||]
#endif

liftPrefix :: Prefix -> ExpQ
liftPrefix :: Prefix -> Q Exp
liftPrefix Prefix
ci = let s :: String
s = Prefix -> String
forall s. CI s -> s
CI.original Prefix
ci in [e| CI.mk s |]

liftText :: T.Text -> ExpQ
liftText :: Text -> Q Exp
liftText Text
s = [e| T.pack $(litE (stringL (T.unpack s))) |]

liftUTC :: UTCTime -> ExpQ
liftUTC :: UTCTime -> Q Exp
liftUTC UTCTime
u = [e| unsafeParseUTC $(liftText (printUTC u)) |]

liftMaybeUTCTime :: Maybe UTCTime -> ExpQ
liftMaybeUTCTime :: Maybe UTCTime -> Q Exp
liftMaybeUTCTime Maybe UTCTime
Nothing  = [e| Nothing |]
liftMaybeUTCTime (Just UTCTime
u) = [e| Just $(liftUTC u) |]

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

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

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

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

instance Lift TypeName where
  lift :: TypeName -> Q Exp
lift (TypeName Text
s) = [e| TypeName $(liftText s) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: TypeName -> Q (TExp TypeName)
liftTyped (TypeName Text
s) = [e|| TypeName $$(liftTypedText s) ||]
#endif

instance Lift FieldName where
  lift :: FieldName -> Q Exp
lift (FieldName Text
s) = [e| FieldName $(liftText s) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: FieldName -> Q (TExp FieldName)
liftTyped (FieldName Text
s) = [e|| FieldName $$(liftTypedText s) ||]
#endif

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

instance Lift RegEx where
  lift :: RegEx -> Q Exp
lift RegEx
re = [e| mkRegEx $(liftText (re_text re)) |]
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: RegEx -> Q (TExp RegEx)
liftTyped RegEx
re = [e|| mkRegEx $$(liftTypedText (re_text re)) ||]
#endif

instance Lift DefaultValue where
  lift :: DefaultValue -> Q 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 :: DefaultValue -> Q (TExp 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)

$(deriveJSON defaultOptions ''Thing)
$(deriveJSON defaultOptions ''APINode)
$(deriveJSON defaultOptions ''TypeName)
$(deriveJSON defaultOptions ''FieldName)
$(deriveJSON defaultOptions ''Spec)
$(deriveJSON defaultOptions ''APIType)
$(deriveJSON defaultOptions ''DefaultValue)
$(deriveJSON defaultOptions ''SpecEnum)
$(deriveJSON defaultOptions ''SpecUnion)
$(deriveJSON defaultOptions ''SpecRecord)
$(deriveJSON defaultOptions ''FieldType)
$(deriveJSON defaultOptions ''SpecNewtype)
$(deriveJSON defaultOptions ''Filter)
$(deriveJSON defaultOptions ''IntRange)
$(deriveJSON defaultOptions ''UTCRange)
$(deriveJSON defaultOptions ''BasicType)
$(deriveJSON defaultOptions ''CI.CI)