    {-|
    Copyright  :  (C) 2013-2016, University of Twente
    License    :  BSD2 (see the file LICENSE)
    Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
    -}

    {-# LANGUAGE TemplateHaskell #-}

    {-# LANGUAGE Trustworthy #-}

    {-# OPTIONS_HADDOCK show-extensions #-}

    module Clash.Promoted.Nat.TH
      ( -- * Declare a single @d\<N\>@ literal
        decLiteralD
        -- * Declare ranges of @d\<N\>@ literals
      , decLiteralsD
      )
    where

    import Language.Haskell.TH
    import Clash.Promoted.Nat

    {- $setup
    >>> :set -XDataKinds
    >>> :m -Prelude
    >>> import Clash.Prelude
    >>> let d1111 = SNat :: SNat 1111
    >>> let d1200 = SNat :: SNat 1200
    >>> let d1201 = SNat :: SNat 1201
    >>> let d1202 = SNat :: SNat 1202
    -}

    -- | Create an 'SNat' literal
    --
    -- > $(decLiteralD 1111)
    --
    -- >>> :t d1111
    -- d1111 :: SNat 1111
    --
    decLiteralD :: Integer
                -> Q [Dec]
    decLiteralD :: Integer -> Q [Dec]
    decLiteralD Integer
    n = do
      let suffix :: String
    suffix  = if Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 then String -> String
    forall a. HasCallStack => String -> a
    error (String
    "Can't make negative SNat: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    n) else Integer -> String
    forall a. Show a => a -> String
    show Integer
    n
          valName :: Name
    valName = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ Char
    'd'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    suffix
      sig   <- Name -> Q Type -> Q Dec
    forall (m :: Type -> Type). Quote m => Name -> m Type -> m Dec
    sigD Name
    valName (Q Type -> Q Type -> Q Type
    forall (m :: Type -> Type). Quote m => m Type -> m Type -> m Type
    appT (Name -> Q Type
    forall (m :: Type -> Type). Quote m => Name -> m Type
    conT ''SNat) (Q TyLit -> Q Type
    forall (m :: Type -> Type). Quote m => m TyLit -> m Type
    litT (Integer -> Q TyLit
    forall (m :: Type -> Type). Quote m => Integer -> m TyLit
    numTyLit Integer
    n)))
      val   <- valD (varP valName) (normalB [| SNat |]) []
      return [ sig, val ]

    -- | Create a range of 'SNat' literals
    --
    -- > $(decLiteralsD 1200 1202)
    --
    -- >>> :t d1200
    -- d1200 :: SNat 1200
    -- >>> :t d1201
    -- d1201 :: SNat 1201
    -- >>> :t d1202
    -- d1202 :: SNat 1202
    --
    decLiteralsD :: Integer
                 -> Integer
                 -> Q [Dec]
    decLiteralsD :: Integer -> Integer -> Q [Dec]
    decLiteralsD Integer
    from Integer
    to =
        ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Dec]] -> [Dec]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ [Q [Dec]] -> Q [[Dec]]
    forall (t :: Type -> Type) (m :: Type -> Type) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
    sequence ([Q [Dec]] -> Q [[Dec]]) -> [Q [Dec]] -> Q [[Dec]]
    forall a b. (a -> b) -> a -> b
    $ [ Integer -> Q [Dec]
    decLiteralD Integer
    n | Integer
    n <- [Integer
    from..Integer
    to] ]