editable (empty) → 1.0.0.0

raw patch · 5 files changed

+215/−0 lines, 5 filesdep +basedep +textdep +vtysetup-changed

Dependencies added: base, text, vty, vty-ui

Files

Data/Editable.hs +132/−0
LICENSE +26/−0
Setup.hs +2/−0
demo.hs +16/−0
editable.cabal +39/−0

+ Data/Editable.hs view

@@ -0,0 +1,132 @@+{-# LANGUAGE DefaultSignatures, FlexibleContexts, ScopedTypeVariables, TypeOperators, DeriveGeneric, FlexibleInstances, ScopedTypeVariables, OverloadedStrings, UndecidableInstances, OverlappingInstances #-}+module Data.Editable (editor, Editable, Parseable(..)) where++import GHC.Generics+import Graphics.Vty.Widgets.All+import qualified Data.Text as T+import Graphics.Vty hiding (Button)+import Control.Concurrent+import Text.Read+import Data.Monoid+import Data.Typeable+import Data.IORef++-- | A type is parseable if you can:+--+-- * From a string return either a value or an error message.+--+-- * Represent a value as a string.+--+-- * Showing a value then reading it yields the same value.+--+-- * The type can be pretty printed.+--+-- With overlapping instances, you get this instance for free for any+-- type that is in 'Show', 'Read' and 'Typeable'. The 'String' instance is also+-- provided so quotes are not required.+class Parseable a where+  reader :: String -> Either String a+  shower :: a -> String+  typeName :: a -> String++instance Parseable [Char] where+  reader = Right+  shower = id+  typeName _ = "String"++instance (Show a, Read a, Typeable a) => Parseable a where+  reader = readEither+  shower = show+  typeName = show . typeRep . proxy+    where+      proxy :: a -> Proxy a+      proxy _ = Proxy++-- | Launch an editor for a value with @editor@.+-- Editable can be derived with @instance Editable a@ so long as:+--+-- * @a@ instances 'Generic' (i.e. have @deriving Generics@ on the type).+--+-- * All the constructors' fields' types are 'Parseable'.+class Editable a where+  -- | Launch an interactive editor for a value.+  editor :: a -> IO a++  default editor :: (Generic a, GEditable (Rep a)) => a -> IO a+  editor = fmap to . geditor Nothing Nothing . from++class GEditable f where+  geditor :: Maybe String -> Maybe String -> f a -> IO (f a)++instance (Parseable e) => GEditable (K1 i e) where+  geditor t c = fmap K1 . (\x -> edit t c Nothing x) . unK1++instance (GEditable e, Constructor c) => GEditable (M1 C c e) where+  geditor t _ x = fmap M1 . geditor t (Just $ conName x) $ unM1 x++instance (GEditable e, Datatype c) => GEditable (M1 D c e) where+  geditor _ c x = fmap M1 . geditor (Just $ datatypeName x) c $ unM1 x++instance (GEditable e, Selector c) => GEditable (M1 S c e) where+  geditor t c = fmap M1 . geditor t c . unM1++instance (GEditable b, GEditable c) => GEditable (b :*: c) where+  geditor t d (b :*: c) = do+    l <- geditor t d b+    r <- geditor t d c+    return (l :*: r)++instance (GEditable b, GEditable c) => GEditable (b :+: c) where+  geditor t c (L1 l) = fmap L1 $ geditor t c l+  geditor t c (R1 r) = fmap R1 $ geditor t c r++instance GEditable U1 where+  geditor _ _ U1 = do+    putStrLn "Editing () yields ()" -- not so true, can't pick ⊥+    return U1++-- the vty editor++edit :: Parseable a => Maybe String -> Maybe String -> Maybe String -> a -> IO a+edit datatype fieldName pError initialV = do+  -- To stop VTY from catching GHCI's first enter keypress+  threadDelay 1++  isBottom <- newIORef False++  e <- editWidget+  setEditText e (T.pack (shower initialV))+  setEditCursorPosition (0, length (shower initialV)) e++  fg <- newFocusGroup+  _ <- addToFocusGroup fg e++  be <- bordered =<< boxFixed 40 1 e++  c <- centered =<< ((plainText     $"Data type:   " <> maybe "unknown" T.pack datatype)+                     <--> plainText ("Constructor: " <> maybe "unknown" T.pack fieldName)+                     <--> plainText ("Field type:  " <> (T.pack (typeName initialV)))+                     <--> plainText (maybe "" (T.pack . (++) "Parse error: ") pError)+                     <--> (return be)+                     <--> plainText "Push ESC to use ⊥."+                     >>= withBoxSpacing 1 )++  coll <- newCollection+  _ <- addToCollection coll c fg++  fg `onKeyPressed` \_ k _ ->+    case k of+      KEsc -> shutdownUi >> writeIORef isBottom True >> return True+      KEnter -> shutdownUi >> return True+      _ -> return False++  runUi coll defaultContext++  isb <- readIORef isBottom+  if isb then return undefined+    else do+      res <- T.unpack `fmap` getEditText e+      case reader res of+        Right x -> return x+        Left er -> do+          edit datatype fieldName (Just $ "Failed to parse: " ++ show res ++ "\n" ++ er) initialV

+ LICENSE view

@@ -0,0 +1,26 @@+Copyright (c) 2014, Maxwell Swadling+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the+   distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ demo.hs view

@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveGeneric #-}+module Demo where++import Data.Editable+import GHC.Generics++data Foo = Bar String Int | Baz Int+  deriving (Show, Generic)++instance Editable Foo++main = do+  let before = Bar "Words" 4+  print before+  after <- editor before+  print after

+ editable.cabal view

@@ -0,0 +1,39 @@+name:                editable+version:             1.0.0.0+synopsis:            Interactive editors for Generics+description:         +  Editable can derive editors for data types.+  .+  Add @deriving Generic@ and @instance Editable Foo@ to your+  data type, and you can launch an editor for it with+  @editor :: Editable a => a -> IO a@.+  .+  @+    {-# LANGUAGE DeriveGeneric #-}+    module Demo where+  .+    import Data.Editable+    import GHC.Generics+  .+    data Foo = Bar String Int | Baz Int+      deriving (Show, Generic)+  .+    instance Editable Foo+  @+  <<https://cloud.githubusercontent.com/assets/136101/3006789/f235419e-de4d-11e3-8a4e-796d5b9ae49c.png>>++license:             BSD2+license-file:        LICENSE+author:              Maxwell Swadling+maintainer:          maxwellswadling@gmail.com+copyright:           Copyright (C) 2014 Maxwell Swadling+category:            Data+build-type:          Simple+extra-source-files:  demo.hs+cabal-version:       >=1.10++library+  ghc-options:         -Wall+  exposed-modules:     Data.Editable+  build-depends:       base >=4.6 && <4.8, text >=1.1 && <1.2, vty == 4.7.5, vty-ui == 1.7.*+  default-language:    Haskell2010