Use System.Hclip instead of System.Clipboard

package.yaml

@@ -50,11 +50,11 @@ dependencies:
 - primitive
 - monad-parallel
 - parallel
-- Clipboard
 - tasty
 - tasty-hunit
 - tasty-quickcheck
 - list-tries
+- Hclip
 
 library:
   source-dirs: src

src/Dodge/Data/Universe.hs

@@ -25,7 +25,6 @@ import Dodge.Data.Config
 import Dodge.Data.World
 import Loop.Data
 import Picture.Data
-import Linear
 --import SDL (Scancode)
 
 data Universe = Universe
@@ -50,16 +49,9 @@ data Universe = Universe
 
 data DebugItem = DebugItem
     { _debugMessage :: String
-    , _debugFunction :: String -> Universe -> Universe
+    , _debugFunction :: Universe -> Universe
     }
 
-data DebugInfo
-    = NoDebugInfo
-    | DebugV3 { _debugV3 :: V3 Float}
-    | DebugV2 { _debugV2 :: V2 Float}
-    | DebugMInt { _debugMInt :: Maybe Int}
-    | DebugIntMInt {_debugInt :: Int, _debugMInt :: Maybe Int}
-
 data SideEffect
     = NewSideEffect
         { _ceSideEffect :: IO (Universe -> Maybe Universe)
@@ -115,4 +107,3 @@ makeLenses ''MenuOptionDisplay
 makeLenses ''MenuOption
 makeLenses ''ExtraMenuOption
 makeLenses ''DebugItem
-makeLenses ''DebugInfo

src/Dodge/Debug.hs

@@ -2,6 +2,8 @@
 
 module Dodge.Debug (debugEvents,drawDebug) where
 
+import qualified SDL
+import System.Hclip
 import Control.Lens
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
@@ -27,8 +29,8 @@ debugEvents u = case dbools ^. at Display_debug of
 overDebugEvent :: Universe -> Universe
 overDebugEvent u = fromMaybe u $ do
     OverDebug db i <- u ^? uvWorld . input . mouseContext
-    DebugItem s f <- u ^? uvDebug . ix db . ix i
+    f <- u ^? uvDebug . ix db . ix i . debugFunction
-    return $ f s u
+    return $ f u
 
 debugEvent :: DebugBool -> Universe -> Universe
 debugEvent db u = u & uvDebug . at db .~ debugItem db u
@@ -72,12 +74,14 @@ drawCrInfo :: Universe -> [DebugItem]
 drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
   where
     w = u ^. uvWorld
-    g h str = fmap $ ((rightPad 7 '.' str ++ "...") ++) . h
+    g h ls x = do
+        rs <- h <$> x
+        return $ DebugItem ((rightPad 7 '.' ls ++ "...") ++ rs) (setclip rs)
     f cr = fromMaybe [] $ do
         guard $
             pointIsOnScreen (u ^. uvConfig) (w ^. wCam) (cr ^. crPos . _xy)
                 && cr ^. crID /= 0
-        Just $ (\x -> DebugItem x (const id)) <$> catMaybes
+        Just $ catMaybes
                     [ g show "crID" $ cr ^? crID
                     , g show "crHP" $ cr ^? crHP . _HP
                     , g show "crStrategy" $ cr ^? crActionPlan . apStrategy
@@ -86,6 +90,9 @@ drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
                     , g show "crAction" $ cr ^? crActionPlan . apAction
                     , g show "crImpulse" $ cr ^? crActionPlan . apImpulse
                     ]
+    setclip s u'' = fromMaybe u'' $ do
+        guard (SDL.ButtonLeft `M.member` (u'' ^. uvWorld . input . mouseButtons))
+        return $ u'' & uvIOEffects %~ (\m u' -> setClipboard s >> m u')
 
 --closestCreatureID :: Universe -> Maybe Int
 --closestCreatureID u =

src/Dodge/Menu.hs

@@ -26,7 +26,7 @@ import MaybeHelp
 import Padding
 import Preload.Update
 import qualified SDL
-import System.Clipboard
+import System.Hclip
 import System.Directory
 import Text.Read
 
@@ -95,8 +95,8 @@ seedStartOptions =
 
 trySeedFromClipboard :: Universe -> IO Universe
 trySeedFromClipboard u = do
-    mcstr <- getClipboardString
+    str <- getClipboard
-    return $ case mcstr >>= readMaybe of
+    return $ case readMaybe str of
         Nothing ->
             pushScreen
                 (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")

src/Dodge/Update/Input/DebugTest.hs

@@ -10,7 +10,7 @@ module Dodge.Update.Input.DebugTest (
 ) where
 
 import Text.Read
-import System.Clipboard
+import System.Hclip
 import Data.Aeson
 import AesonHelp
 import Control.Lens
@@ -71,8 +71,8 @@ doDebugTestF10 = uvIOEffects %~ \f u -> do
     f u
 doDebugTestF11 :: Universe -> Universe
 doDebugTestF11 = uvIOEffects %~ \f u -> do
-    x <- getClipboardString
+    x <- getClipboard
-    case x >>= readMaybe of
+    case readMaybe x of
         Nothing -> do
             putStrLn "read fail"
             f u

stack.yaml

@@ -43,6 +43,7 @@ extra-deps:
     #- SDL-0.6.7.0@sha256:9d6ba75c0cab575ec38468c8277803983e985f9622437aeca6a53e6a7337a7d5,2045
 - sdl2-mixer-1.2.0.0@sha256:6a6b5a46c035c9e77eaf9c244e45de9e4a9b9a110890cfeeb9fa72faa2419cef,4497   
 - list-tries-0.6.7.1@sha256:a53b4a466d2ecdb932da4c1d34ec8dda99d9eba2977eb991f6b052ad710e249d,4272
+- Hclip-3.0.0.4@sha256:df341c936594465df25c3b9f93f6ebe3110a36d64a51dbbd1dbd557394bbdba4,1648
   #- repa-3.4.1.5@sha256:4d94845e66d668345130f75f5de8f7c69139b91495c8c4b5a825014e8985e2fd,3562
   #- strict-containers-0.1@sha256:d751696a8a74e368cf778cf98410b43fcd192d68febd4c691faaac1d6c3ab63f,10591
   #- strict-containers-lens-0.1@sha256:97c0e68e2e23578074d41fa45690a9ff7b1d47057ea6635d863af99f0daa2f9d,1103