Sketch of an idea to use graded categories to enforce the clean architecture at compile-time.

CertifiedCleanSevenDaysAWeek.hs

{-# LANGUAGE DataKinds, KindSignatures, TypeOperators, TypeFamilies #-}

module Main where

{-
   Fun with graded categories and lattices: Enforcing the
   Clean Architecute at compile time.

   Alternate sub-title:
      Certified clean, seven days a week
      SOLID Haskell, make that OOP game weak.

   Basic idea: Consider the three-element poset:

           Infrastructure

                |
                |
                
            Application
                 
                |
                |

              Domain

   Each represents a "layer" in Robert C. Martin's "Clean architecture".

   If we write our code in a graded category over this lattice, we can
   enforce adherence to this architecture at compile-time.

   This is because, the semantics of graded categories means that
   morphisms at "lower levels" can only be "used" by those at
   "higher levels", just as is required in the clean architecture.

   Let's define an enum for a "level":
-}

data ArchitecuteLevel =
    Infrastructure
  | Application
  | Domain 
      deriving(Eq, Ord)

type family Join (a :: ArchitecuteLevel) (b :: ArchitecuteLevel) :: ArchitecuteLevel where
  Join Domain Domain = Domain
  Join Domain Application = Application
  Join Domain Infrastructure = Infrastructure
  Join Application Application = Application
  Join Application Infrastructure = Infrastructure
  Join Infrastructure Infrastructure = Infrastructure

{-
  The order here and Ord instance is important, because that is what
  gives the correct order to the levels that is desired above.
-}

{-
  Now let's define a way of using these levels in code! We'll need data kinds:
-}

{-
  because we'll be using ArchitecuteLevel as a phantom parameter of our
  "Clean" type, which acts as a graded monad over ArchitecuteLevel.

  Using newtype here means that code using this Clean graded monad
  will not take any runtime hit compared to pure Haskell functions.
-}

newtype Clean (l :: ArchitecuteLevel) a = Clean { unClean :: a }

{- Now, for convinience, let's define some arrows for our category.
   We'll need TypeOperators for this: -}

infixr 9 -%
infixr 9 -@
infixr 9 -*

type a -% b = a -> Clean Domain b
type a -@ b = a -> Clean Application b
type a -* b = a -> Clean Infrastructure b

compose :: (a -> Clean n b) -> (b -> Clean m c) -> (a -> Clean (Join n m) c)
compose f g = \x -> Clean $ unClean $ g $ unClean $ f x

{- Now, let's define the types in our domain model. In a true graded
  category, we'd be able to define the set of objects at appear
  at a given grade. To emulate this in Haskell, we have to use smart
  constructors for types we only want to be avilable in a certain grade 

  This also means that the module these types are defined in should only
  export the smart constructors of these types, not the constructors themselves. 
  
  The same must be done for projections if deining a record.

  For illustration, constructors and functions that should be private
  I'll put a "_" in the name below.

  This is all pretty tedious to define, but this could all be 
  streamlined with some Template Haskell:
-}

data TodoListEntry = TodoListEntry_ {
    _todoListEntryContents  :: String,
    _todoListEntryCompleted :: Bool
}

todoListEntryContents :: TodoListEntry -% String
todoListEntryContents x = Clean $ _todoListEntryContents x

todoListEntryCompleted :: TodoListEntry -% Bool
todoListEntryCompleted x = Clean $ _todoListEntryCompleted x

newTodoListEntry :: String -% Bool -% TodoListEntry
newTodoListEntry = \contents -> Clean $
   \completed -> Clean $
      TodoListEntry_ contents completed

{- Now let's create some application code. 
  
  Arbuably, this could be considered domain code as well, but
   this is a really barebones example, so I'm making this "Application"
   code. 
   
  The beauty of this approach is that you can choose whatever
  lattice works for you and your software's organization! Not just 
  Uncle Bob's preffered one. -}

data TodoList = TodoList_ {
    _entries :: [TodoListEntry]
}

entries :: TodoList -@ [TodoListEntry]
entries list = Clean $ _entries list

newTodoList :: [TodoListEntry] -@ TodoList
newTodoList entries = Clean $ TodoList_ entries

{- 
    Future work:
       What if higher layers needed more than just the Identity
       monad? Possibly we could use TypeFamilies to enable a 
       scheme like that.
-}