From 77b0b3b396aa8ab79b222acd5af753d1af0f6720 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 21 Jun 2018 18:52:45 +0300
Subject: [PATCH] Drop dependency on stackage-curator

---
 package.yaml             |  1 -
 src/Handler/BuildPlan.hs |  8 ++--
 src/Stackage/Types.hs    | 88 ++++++++++++++++++++++++++++++++++++++++
 stack.yaml               |  1 -
 4 files changed, 93 insertions(+), 5 deletions(-)
 create mode 100644 src/Stackage/Types.hs

diff --git a/package.yaml b/package.yaml
index 335ef27..83febd2 100644
--- a/package.yaml
+++ b/package.yaml
@@ -75,7 +75,6 @@ dependencies:
 - hoogle
 - deepseq
 - auto-update
-- stackage-curator
 - yesod-sitemap
 - streaming-commons
 - classy-prelude-conduit
diff --git a/src/Handler/BuildPlan.hs b/src/Handler/BuildPlan.hs
index d1dfd39..be9ee74 100644
--- a/src/Handler/BuildPlan.hs
+++ b/src/Handler/BuildPlan.hs
@@ -2,12 +2,13 @@
 module Handler.BuildPlan where
 
 import Import hiding (get, PackageName (..), Version (..), DList)
-import Stackage.Types
-import Stackage.ShowBuildPlan
+--import Stackage.Types
 import Stackage.Database
 
 getBuildPlanR :: SnapName -> Handler TypedContent
-getBuildPlanR slug = track "Handler.BuildPlan.getBuildPlanR" $ do
+getBuildPlanR _slug = track "Handler.BuildPlan.getBuildPlanR" $ do
+    error "temporarily disabled, please open on issue on https://github.com/fpco/stackage-server/issues/ if you need it"
+    {-
     fullDeps <- (== Just "true") <$> lookupGetParam "full-deps"
     spec <- parseSnapshotSpec $ toPathPiece slug
     let set = setShellCommands simpleCommands
@@ -21,3 +22,4 @@ getBuildPlanR slug = track "Handler.BuildPlan.getBuildPlanR" $ do
         provideRep $ return $ toSimpleText toInstall
         provideRep $ return $ toJSON toInstall
         provideRepType "application/x-sh" $ return $ toShellScript set toInstall
+    -}
diff --git a/src/Stackage/Types.hs b/src/Stackage/Types.hs
new file mode 100644
index 0000000..9cbd4e6
--- /dev/null
+++ b/src/Stackage/Types.hs
@@ -0,0 +1,88 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Stackage.Types
+  ( BuildPlan (..)
+  , SystemInfo (..)
+  , PackagePlan (..)
+  , DocMap
+  , PackageDocs (..)
+  , PackageName
+  , Version
+  , display
+  ) where
+
+import qualified Distribution.Text               as DT
+import ClassyPrelude.Conduit
+import Data.Aeson
+import Distribution.Types.PackageName (PackageName, mkPackageName)
+import Distribution.Version (Version)
+import Control.Monad.Catch (MonadThrow, throwM)
+import Data.Typeable (TypeRep, Typeable, typeOf)
+
+data BuildPlan = BuildPlan
+  { bpSystemInfo :: !SystemInfo
+  , bpPackages :: !(Map PackageName PackagePlan)
+  }
+instance FromJSON BuildPlan where
+  parseJSON = withObject "BuildPlan" $ \o -> BuildPlan
+    <$> o .: "system-info"
+    <*> o .: "packages"
+
+data SystemInfo = SystemInfo
+  { siGhcVersion :: !Version
+  , siCorePackages :: !(Map PackageName Version)
+  }
+instance FromJSON SystemInfo where
+  parseJSON = withObject "SystemInfo" $ \o -> SystemInfo
+    <$> o .: "ghc-version"
+    <*> o .: "core-packages"
+
+data PackagePlan = PackagePlan
+  { ppVersion :: Version
+  }
+instance FromJSON PackagePlan where
+  parseJSON = withObject "PackagePlan" $ \o -> PackagePlan
+    <$> o .: "version"
+
+type DocMap = Map Text PackageDocs
+
+data PackageDocs = PackageDocs
+    { pdVersion :: !Text
+    , pdModules :: !(Map Text [Text])
+    }
+instance FromJSON PackageDocs where
+    parseJSON = withObject "PackageDocs" $ \o -> PackageDocs
+        <$> o .: "version"
+        <*> o .: "modules"
+
+display :: DT.Text a => a -> Text
+display = fromString . DT.display
+
+data ParseFailedException = ParseFailedException TypeRep Text
+    deriving (Show, Typeable)
+instance Exception ParseFailedException
+
+simpleParse :: (MonadThrow m, DT.Text a, Typeable a) => Text -> m a
+simpleParse orig = withTypeRep $ \rep ->
+    case DT.simpleParse str of
+        Nothing -> throwM (ParseFailedException rep (pack str))
+        Just v  -> return v
+  where
+    str = unpack orig
+
+    withTypeRep :: Typeable a => (TypeRep -> m a) -> m a
+    withTypeRep f =
+        res
+      where
+        res = f (typeOf (unwrap res))
+
+        unwrap :: m a -> a
+        unwrap _ = error "unwrap"
+
+-- orphans
+
+instance FromJSON Version where
+  parseJSON = withText "Version" $ either (fail . show) pure . simpleParse
+instance FromJSON PackageName where
+  parseJSON = withText "PackageName" $ pure . mkPackageName . unpack
+instance FromJSONKey PackageName where
+  fromJSONKey = FromJSONKeyText $ mkPackageName . unpack
diff --git a/stack.yaml b/stack.yaml
index f40097d..cb65c0f 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -2,4 +2,3 @@ resolver: nightly-2018-06-20
 extra-deps:
 - archive: https://github.com/snoyberg/gitrev/archive/6a1a639f493ac08959eb5ddf540ca1937baaaaf9.tar.gz
 - archive: https://github.com/bitemyapp/esqueleto/archive/b81e0d951e510ebffca03c5a58658ad884cc6fbd.tar.gz
-- archive: https://github.com/fpco/stackage-curator/archive/7635cdc45fcc7c1b733957bce865c40ae8e22b0c.tar.gz