fix

compa4ek.cabal

@@ -32,9 +32,11 @@ common common-options
   default-language:    Haskell2010
   build-depends:       base >= 4.12.0.0 && < 4.14
                      , aeson
+                     , containers
                      , insert-ordered-containers
                      , openapi3
                      , text
+
   default-extensions: ConstraintKinds
                     , DataKinds
                     , DeriveFoldable

src/OpenAPI/Checker/Report.hs

@@ -1,7 +1,12 @@
 module OpenAPI.Checker.Report where
 
-import           Data.Text    (Text)
-import           GHC.Generics (Generic)
+import           Data.Map.Strict                as M
+import           Data.Text                      (Text)
+import           GHC.Generics                   (Generic)
+import           OpenAPI.Checker.Validate.Monad
+
+printReport :: Report -> IO ()
+printReport = error "FIXME: printReport not implemented"
 
 data Report = Report
   { status :: Status
@@ -11,21 +16,29 @@ data Report = Report
 data Status = Success | Fail Text
   deriving (Eq, Ord, Show, Generic)
 
-type Errorable = Either Text
-
 type Path = FilePath -- From the library
 
 data ReportTree = ReportTree
-  { paths :: [PathTree]
+  { paths :: Map Path (Errorable PathItemTree)
   } deriving (Eq, Ord, Show, Generic)
 
-data PathTree = PathTree
-  { path     :: Path
-  , pathItem :: Errorable PathItemTree
-  } deriving (Eq, Ord, Show, Generic)
+newtype PathItemTree = PathItemTree
+  { operations :: Map OperationName (Errorable OperationTree)
+  } deriving (Eq, Ord, Show, Generic, Semigroup, Monoid)
 
-data PathItemTree = PathItemTree
+instance Nested PathItemTree where
+  type Parent PathItemTree = ReportTree
+  type Key PathItemTree = Path
+  nest key p = ReportTree $ M.singleton key p
+
+data OperationName
+  = Get | Put | Post | Delete | Options | Head | Patch | Trace
   deriving (Eq, Ord, Show, Generic)
 
-printReport :: Report -> IO ()
-printReport = error "FIXME: printReport not implemented"
+data OperationTree = OperationTree
+  deriving (Eq, Ord, Show, Generic)
+
+instance Nested OperationTree where
+  type Parent OperationTree = PathItemTree
+  type Key OperationTree = OperationName
+  nest key p = PathItemTree $ M.singleton key p

src/OpenAPI/Checker/Validate.hs

@@ -5,6 +5,7 @@ import           Data.Functor
 import           Data.HashMap.Strict.InsOrd     as InsMap
 import           Data.HashSet.InsOrd            as InsSet
 import           Data.OpenApi
+import           Data.OpenApi.Internal
 import           Data.Traversable
 import           OpenAPI.Checker.Report
 import           OpenAPI.Checker.Validate.Monad
@@ -13,17 +14,29 @@ reportCompat :: OpenApi -> OpenApi -> Report
 reportCompat = error "FIXME: reportCompat not implemented"
 
 forwardCompatible :: OpenApi -> OpenApi -> ReportTree
-forwardCompatible dec enc = fst $ runReportTreeT $ openApiCompatible dec enc
+forwardCompatible dec enc = fst $ runTreeM $ openApiCompatible dec enc
 
-openApiCompatible :: OpenApi -> OpenApi -> ReportTreeT ()
+openApiCompatible :: OpenApi -> OpenApi -> TreeM ReportTree ()
 openApiCompatible dec enc = void $ follow $
   (InsMap.toList $ _openApiPaths dec) <&> \(path, encItem) ->
   (path, checkItem path encItem)
   where
+    -- checkItem :: Path -> PathItem -> TreeM PathItemTree ()
     checkItem path encItem = do
       case (InsMap.lookup path $ _openApiPaths enc) of
         Nothing      -> pathError $ "Path deleted"
         Just decItem -> pathItemsCompatible encItem decItem
 
-pathItemsCompatible :: PathItem -> PathItem -> ReportTreeT ()
-pathItemsCompatible = error "FIXME: pathItemsCompatible not implemented"
+pathItemsCompatible :: PathItem -> PathItem -> TreeM PathItemTree ()
+pathItemsCompatible dec enc = void $ follow
+  [ (Get, go _pathItemGet)
+  , (Put, go _pathItemPut)
+  , (Post, go _pathItemPost)
+  , (Delete, go _pathItemDelete)
+  , (Options, go _pathItemOptions)
+  , (Head, go _pathItemHead)
+  , (Patch, go _pathItemPatch)
+  , (Trace, go _pathItemTrace) ]
+  where
+    go :: (PathItem -> Maybe Operation) -> TreeM OperationTree ()
+    go getOp = (error "FIXME: not implemented")

src/OpenAPI/Checker/Validate/Monad.hs

@@ -1,23 +1,30 @@
 module OpenAPI.Checker.Validate.Monad where
 
-import           Data.Text              (Text)
-import           OpenAPI.Checker.Report
-
-data ReportTreeT a = ReportTreeT
-
-instance Functor ReportTreeT
-instance Applicative ReportTreeT
-instance Monad ReportTreeT
+import           Data.Text (Text)
 
 
-runReportTreeT :: ReportTreeT a -> (ReportTree, a)
-runReportTreeT = error "FIXME: runReportTree not implemented"
+data TreeM t a = TreeM
+instance Functor (TreeM t)
+instance Applicative (TreeM t)
+instance Monad (TreeM t)
 
-pathError :: Text -> ReportTreeT a
+type Errorable = Either Text
+
+-- | Class of trees nested into another trees
+class Nested t where
+  type Parent t
+  type Key t
+  nest :: Key t -> Errorable t -> Parent t
+
+runTreeM :: TreeM t a -> (t, a)
+runTreeM = error "FIXME: runReportTree not implemented"
+
+pathError :: Text -> TreeM t a
 pathError = error "FIXME: pathError not implemented"
 
+-- | Runs several computations in different paths
 follow
-  :: (Traversable f)
-  => f (Path, ReportTreeT a)
-  -> ReportTreeT (f a)
+  :: (Traversable f, Nested t)
+  => f (Key t, TreeM t a)
+  -> TreeM (Parent t) (f a)
 follow = error "FIXME: follow not implemented"