content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE DeriveAnyClass #-}
  {-# LANGUAGE QuasiQuotes #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  module Deriving where
  
  import Data.Proxy (Proxy)
  import Data.Text (Text)
  import Ema.Route.Class
  import Ema.Route.Generic
  import Ema.Route.Generic.TH
  import GHC.Generics qualified as GHC
  import Generics.SOP qualified as SOP
  import Text.RawString.QQ (r)
  
  #define ENABLE_SPEC
  
  ----------------------------------------
  -- Subroute verification
  ----------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data BadRoute = BR_1 Int String | BR_2 String
  data M = M { m1 :: (), m2 :: () } deriving stock GHC.Generic
  
  deriveGeneric ''BadRoute
  -- Subroutes should not have constructors with multiple fields
  -- Expect: MultiRoute: too many arguments
  deriveIsRoute ''BadRoute [t|
      '[ WithModel M
       ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -----------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R_1 () | R_2 ()
  deriveGeneric ''R
  -- WithSubRoutes' list should not be shorter than number of route constructors
  -- Expect:
  {-
  'WithSubRoutes' is missing subroutes for:
  
    '[()]
  -}
  deriveIsRoute ''R [t|
    '[ WithSubRoutes '[ () ] ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -----------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R_1 () | R_2 ()
  deriveGeneric ''R
  -- WithSubRoutes' list should not be longer than number of route constructors
  -- Expect:
  {-
  'WithSubRoutes' has extra unnecessary types:
  
    '[Int]
  -}
  deriveIsRoute ''R [t|
    '[ WithSubRoutes '[ (), (), Int ] ]
    |]
  #endif
  #define ENABLE_SPEC
  
  ------------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R_1 Int | R_2
  deriveGeneric ''R
  -- constructors should either be empty or contain () when 'WithSubRoutes' specifies ()
  -- Expect:
  {-
  A 'WithSubRoutes' entry is '()' instead of the expected:
  Int
  -}
  deriveIsRoute ''R [t|
    '[ WithSubRoutes '[ (), () ] ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -------------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R_1 | R_2 
  deriveGeneric ''R
  -- subroute types that are nonisomorphic to what is specified in 'WithSubRoutes' should be illegal
  -- Expect:
  {-
  Couldn't match representation of type ‘()’ with that of ‘Bool’
    arising from a use of ‘routePrism’
  -}
  deriveIsRoute ''R [t|
    ' [ WithSubRoutes '[ (), Bool] ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -------------------------------------------
  
  -- subroute types that are the same as what is specified in 'WithSubRoutes' should typecheck"
  data RSubIso = RSubIso_1 | RSubIso_2
  deriveGeneric ''RSubIso
  deriveIsRoute
    ''RSubIso
    [t|
      '[WithSubRoutes '[(), ()]]
      |]
  
  -------------------------------------------
  
  -- FIXME: This test is broken.
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  routeSpec "subroute types that are an unwrapped representation of what is specified in 'WithSubRoutes' should typecheck | ( empty constructor <-> () ) special case"
    (niceRoute ''() ''())
    [t|
      '[ WithModel (NiceNamedM () ())
       , WithSubRoutes '[ (), PlainR_NiceNamedM ]
       ]
    |]
    [r|
    |]
  #endif
  #define ENABLE_SPEC
  
  -------------------------------------------
  
  -- Subroute types that are an unwrapped representation of what is specified in
  -- 'WithSubRoutes' should typecheck | (wrapper deriving /newtype/ GHC.Generic)
  -- case"
  data RSubNewtype = RSubNewtype_1 | RSubNewtype_2
  deriveGeneric ''RSubNewtype
  newtype WrapNewtype a = WrapNewtype a
    deriving newtype (GHC.Generic, IsRoute)
  deriveIsRoute
    ''RSubNewtype
    [t|
      '[ WithSubRoutes '[(), WrapNewtype ()]
       ]
      |]
  
  -------------------------------------------
  -- Submodel verification
  -------------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R1 | R2 
  deriveGeneric ''R 
  data M = M { m1 :: (), m2 :: () } deriving stock GHC.Generic
  -- Submodel selectors should not be less than number of subroutes
  -- Expect:
  {-
  'WithSubModels' is missing submodel types:
    '[()]
  -}
  deriveIsRoute ''R 
    [t|
      '[ WithModel M
       , WithSubModels '[ Proxy "m1" ]
       ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -------------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R1 | R2 
  deriveGeneric ''R 
  data M = M { m1 :: (), m2 :: () }
    deriving stock GHC.Generic
  -- submodel selectors should not outnumber number of subroutes
  -- Expect:
  {-
  'WithSubModels' has extra unnecessary types:
  
    '[Proxy "m2"]
  -}
  deriveIsRoute ''R
    [t|
      '[ WithModel M
       , WithSubModels '[ Proxy "m1", Proxy "m2", Proxy "m2" ]
       ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -------------------------------------------
  data RSubMSelf = RSubMSelf1 | RSubMSelf2 RSubMSelf
    deriving stock (GHC.Generic)
  deriveGeneric ''RSubMSelf
  data MSelf = MSelf {mself1 :: (), mself2 :: ()}
    deriving stock (GHC.Generic)
  
  -- submodel type selectors be able to reference the model itself if they are of the same type
  deriveIsRoute
    ''RSubMSelf
    [t|
      '[ WithModel MSelf
       , WithSubModels '[Proxy "mself1", MSelf]
       ]
      |]
  
  -------------------------------------------
  
  #undef ENABLE_SPEC
  #ifdef ENABLE_SPEC
  data R = R1 | R2
  deriveGeneric ''R
  data M = M { m1 :: (), m2 :: () }
    deriving stock GHC.Generic
  -- submodel type selectors must, at a minimum, refer to a model field of a matching type
  -- Expect:
  {-
  Couldn't match type ‘Bool’ with ‘()’
  -}
  deriveIsRoute ''R
    [t|
      '[ WithModel M
       , WithSubModels '[ Proxy "m1", Bool ]
       ]
    |]
  #endif
  #define ENABLE_SPEC
  
  -----------------------------------------
  