StaticPipeline in Haskell (one type class per in/out predicate)

staticpipeline.hs

{-# LANGUAGE NoMonomorphismRestriction #-}

module StaticPipeline where


data Image = Image
data OriginalImage = OriginalImage Image
data ProcessedImage = ProcessedImage Image
data FaceLocation = FaceLocation
data EyeLocation = EyeLocation

someImage = Image

class ProvidesOriginalImage a where
  origImage :: a -> OriginalImage

class ProvidesProcessedImage a where
  procImage :: a -> ProcessedImage

class ProvidesFaceLocation a where
  faceLocation :: a -> FaceLocation

class ProvidesEyeLocation a where
  eyeLocation :: a -> EyeLocation


instance ProvidesOriginalImage Image where
  origImage = OriginalImage

data FaceDetectionResult = FaceDetectionResult {
  fdro :: OriginalImage,
  fdrp :: ProcessedImage,
  fdrf :: FaceLocation
}

instance ProvidesOriginalImage FaceDetectionResult where
  origImage = fdro
instance ProvidesProcessedImage FaceDetectionResult where
  procImage = fdrp
instance ProvidesFaceLocation FaceDetectionResult where
  faceLocation = fdrf

detectFaceLocation :: ProvidesOriginalImage a => a -> FaceDetectionResult
detectFaceLocation i = FaceDetectionResult (OriginalImage someImage) (ProcessedImage someImage) FaceLocation
  where
    oi = origImage i


data EyeDetectionResult = EyeDetectionResult {
  edro :: OriginalImage,
  edrp :: ProcessedImage,
  edre :: EyeLocation
}

instance ProvidesOriginalImage EyeDetectionResult where
  origImage = edro
instance ProvidesProcessedImage EyeDetectionResult where
  procImage = edrp
instance ProvidesEyeLocation EyeDetectionResult where
  eyeLocation = edre

detectEyes :: (ProvidesFaceLocation   a,
               ProvidesProcessedImage a,
               ProvidesOriginalImage  a) => a -> EyeDetectionResult
detectEyes i = EyeDetectionResult (OriginalImage someImage) (ProcessedImage someImage) EyeLocation
  where
    oi = origImage i
    pi = procImage i
    fl = faceLocation i



-- Build a pipeline
faceAndEyes = detectEyes . detectFaceLocation

-- Even trees are easy
treePipeline = doSomethingWithLeaves [eyes1, eyes2]
  where
    face = detectFaceLocation someImage --   someImage
    eyes1 = detectEyes face             --       |
    eyes2 = detectEyes face             --     face
                                        --    /     \
    doSomethingWithLeaves = undefined   -- eyes1   eyes2


main = print "Yes, it looks like we can do this with added pipes / conduits as well."