packages feed

tinytools 0.1.0.0 → 0.1.0.3

raw patch · 7 files changed

+136/−46 lines, 7 filesdep +aeson-prettydep +filepath

Dependencies added: aeson-pretty, filepath

Files

README.md view
@@ -1,50 +1,31 @@-[![CircleCI](https://circleci.com/gh/pdlla/potato-flow.svg?style=svg)](https://circleci.com/gh/pdlla/potato-flow)--# potato-illustrator-`potato-illustrator` is a mono-space text flow-chart editor written in Haskell. It is currently a work in progress and an ALPHA release should be available soon.+# tinytools+`tinytools` is a mono-space unicode flow-chart editor written in Haskell.  # architecture-`potato-illustrator` is written using [reflex](https://github.com/reflex-frp/reflex) and follows a strict MVC architecture. This repository contains the platform-independent model and controller.-The View is connected to the reflex interface defined by `GoatWidget`.+`tinytools` follows a strict MVC architecture. This repository contains the platform-independent model and controller.+The view/controller is connected to the model using a [reflex](https://github.com/reflex-frp/reflex) interface defined by `GoatWidget`. -[potato-illustrator-vty](https://github.com/pdlla/potato-illustrator-vty) is currently the only view implementation. It is written in [reflex-vty](https://github.com/reflex-frp/reflex-vty) and runs in a terminal yay. Please see [potato-illustrator-vty](https://github.com/pdlla/potato-illustrator-vty) if you'd like to try it out.+[tinytools-vty](https://github.com/pdlla/tinytools-vty) is currently the only view implementation. It is written in [reflex-vty](https://github.com/reflex-frp/reflex-vty) and runs in a terminal yay. Please see [tinytools-vty](https://github.com/pdlla/tinytools-vty) if you'd like to try it out.  # features (completed) - sophisticated hierarchical layer system - transactional operations and change history-- several configurable primitives including boxes, lines and text boxes+- several highly configurable primitives including boxes, lines and text boxes+- basic document save/load/export functionality  # roadmap -## alpha-- save/load/export interface-- multi-segment line input-- free form text-area input- ## v1-- UNICODE wide character support+- UNICODE wide character support (currently blocked by issues in TextZipper) - UNICODE glyph widget  ## v2-- attached line support - multi-document support - refactor handle non-linear action do/undo operations in preparation for multi-user mode  ## v3-- graphene clusters support+- grapheme clusters support (blocked by terminal support which is currently extremely inconsistent or non-existent) - multi-user mode   - ordering service interface   - basic single client authoritative implementation of ordering service interface (for now)-- scripting---# Contribution Guide--Help wanted! I will of course review any PR. For large or small ideas, it would be best to drop me an email first at chippermonky at gmail dot com--Below are a list of tasks that I think would be extra good projects to work on--- CI scripts for creating binary releases-- UNICODE wide character support-- add text selection support to current `TextZipper` implementation-- refactoring 😑+- scriptable command interface
src/Potato/Data/Text/Unicode.hs view
@@ -3,26 +3,28 @@  import           Prelude -import Graphics.Text.Width (wcwidth)+import           Graphics.Text.Width     (wcwidth) -import Data.Int -import qualified Data.Text.ICU as ICU-import qualified Data.Text as T-import Data.Text (Text)+import           Data.Int+import           Data.Text               (Text)+import qualified Data.Text               as T+import qualified Data.Text.ICU           as ICU import qualified Potato.Data.Text.Zipper as TZ   ++ -- NOTE this function won't work as expected until you've loaded a termal char width file via vty! getCharWidth :: Char -> Int8 getCharWidth = fromIntegral . TZ.charWidth  removeWideChars :: Text -> Text-removeWideChars = T.filter (\c -> getCharWidth c <= 1) +removeWideChars = T.filter (\c -> getCharWidth c <= 1)  internal_getCharacterBreaks :: Text -> [ICU.Break ()]-internal_getCharacterBreaks input = r where -  breaker = ICU.breakCharacter ICU.Current +internal_getCharacterBreaks input = r where+  breaker = ICU.breakCharacter ICU.Current   r = ICU.breaks breaker input  zwidge :: Char@@ -32,20 +34,20 @@ isSingleGraphemeCluster :: Text -> Bool isSingleGraphemeCluster input = r where   tbreaks = internal_getCharacterBreaks input-  r = case tbreaks of +  r = case tbreaks of     -- no characters, not a grapheme cluster-    [] -> False +    []     -> False     -- only one break, it's a grapheme cluster if it has more than one unicode char in it     (b:[]) -> T.length (ICU.brkBreak b) > 1     -- more than one character break-    _ -> False +    _      -> False  -- | True if the last character in the text is a single grapheme cluster, False otherwise endsInGraphemeCluster :: Text -> Bool endsInGraphemeCluster input = r where   tbreaks' = internal_getCharacterBreaks input-  gotoend tbreaks = case tbreaks of -    [] -> False+  gotoend tbreaks = case tbreaks of+    []     -> False     (b:[]) -> isSingleGraphemeCluster (ICU.brkBreak b)     (_:bs) -> gotoend bs   r = gotoend tbreaks'@@ -58,10 +60,24 @@   -- if there is more than one character in the break then it must have been a grapheme cluster   -- so just use the first character   fmapfn b = case T.uncons (ICU.brkBreak b) of-    Nothing -> ""+    Nothing     -> ""     Just (c, _) -> T.singleton c   r = mconcat $ fmap fmapfn tbreaks  -- | True if the input text contains a grapheme cluster containsGraphemeCluster :: Text -> Bool containsGraphemeCluster input = removeGraphemeCluster input /= input++++-- 🤖 isn't correct, misses emojis :()+{-+getCharWidth :: Char -> Int8+getCharWidth c+  | isControl c || c == '\t' = 0+  | w == 0x0 || w > 0x10ffff = 1+  | w >= 0x1100 && (w <= 0x115f || w == 0x2329 || w == 0x232a || (w >= 0x2e80 && w <= 0xa4cf && w /= 0x303f) || (w >= 0xac00 && w <= 0xd7a3) || (w >= 0xf900 && w <= 0xfaff) || (w >= 0xfe10 && w <= 0xfe19) || (w >= 0xfe30 && w <= 0xfe6f) || (w >= 0xff00 && w <= 0xff60) || (w >= 0xffe0 && w <= 0xffe6) || (w >= 0x20000 && w <= 0x2fffd) || (w >= 0x30000 && w <= 0x3fffd)) = 2+  | otherwise = 1+  where+    w = ord c+-}
src/Potato/Flow.hs view
src/Potato/Flow/Controller/Types.hs view
@@ -29,8 +29,10 @@ import           Data.Default import qualified Data.IntMap            as IM import qualified Text.Show+import           Data.Binary  + -- someday it would be nice to support graphene clusters and RTL 😭 data UnicodeWidthFn = UnicodeWidthFn {     unicodeWidth_wcwidth :: PChar -> Int@@ -112,7 +114,9 @@ instance FromJSON LayerMeta instance ToJSON LayerMeta instance NFData LayerMeta+instance Binary LayerMeta + -- Not sure which way I want to do it, so make it configurable for now. defaultFolderCollapseState :: Bool defaultFolderCollapseState = False@@ -150,6 +154,8 @@  instance FromJSON ControllerMeta instance ToJSON ControllerMeta+instance NFData ControllerMeta+instance Binary ControllerMeta  emptyControllerMeta :: ControllerMeta emptyControllerMeta = ControllerMeta 0 IM.empty
+ src/Potato/Flow/Serialization/Snake.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Serialization.Snake where++import           Relude++import           Potato.Flow.Types+import           Potato.Flow.SElts+import Potato.Flow.Controller.Types++import qualified Data.Aeson               as Aeson+import qualified Data.Aeson.Encode.Pretty as PrettyAeson+import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy as LBS+import           System.FilePath+import qualified Data.Text.Encoding as Text++++-- | list of all version supported+versions :: [Int]+versions = [1]++-- | version of the current build+currentVersion :: Int+currentVersion = 1++data Snake = Snake {+  _snake_version :: Int+  -- string instead of enum type to ensure compatibility if new formats are ever added+  -- currently supports "binary" and "json"+  , _snake_format :: String+  , _snake_data :: Text+} deriving (Eq, Generic, Show)++instance Aeson.FromJSON Snake+instance Aeson.ToJSON Snake+instance Binary.Binary Snake+instance NFData Snake++data SnakeFormat = SF_Json | SF_Binary++serialize :: SnakeFormat -> (SPotatoFlow, ControllerMeta) -> LBS.ByteString+serialize f x = r where+  (inner, format) = case f of+    SF_Json -> (PrettyAeson.encodePretty x, "json")+    SF_Binary -> (Binary.encode x, "binary")+  outer = Snake {+    _snake_version = currentVersion+    , _snake_format = format+    , _snake_data = Text.decodeUtf8 (LBS.toStrict inner)+  }+  r = PrettyAeson.encodePretty outer++deserialize :: LBS.ByteString -> Either String (SPotatoFlow, ControllerMeta)+deserialize lbs = case Aeson.eitherDecode lbs of+  Left e -> Left $ "failed to decode Snake with error " <> e+  Right vso -> deserialize_internal vso+++deserialize_internal :: Snake -> Either String (SPotatoFlow, ControllerMeta)+deserialize_internal Snake {..} = do+  if _snake_version /= currentVersion +    then Left $ "version mismatch, got: " <> show _snake_version <> " expected: " <> show currentVersion+    else return ()+  case _snake_format of+    "json" -> Aeson.eitherDecodeStrict (Text.encodeUtf8 _snake_data)+    "binary" -> case Binary.decode (LBS.fromStrict $ Text.encodeUtf8 _snake_data) of+      Just x -> Right x+      Nothing -> Left "failed to decode binary"+    x -> Left $ "unrecognized fromat" <> show x+++decodeFile :: FilePath -> IO (Either String (SPotatoFlow, ControllerMeta))+decodeFile fp = do+  vsobs <- LBS.readFile fp+  return $ deserialize vsobs+++decodeFileMaybe :: FilePath -> IO (Maybe (SPotatoFlow, ControllerMeta))+decodeFileMaybe fp = do+  x <- decodeFile fp+  case x of+    Left _ -> return Nothing+    Right x -> return (Just x)
test/Potato/Data/Text/UnicodeSpec.hs view
@@ -36,4 +36,3 @@   it "containsGraphemeCluster" $ do     containsGraphemeCluster "👎👎👎👎👎" `shouldBe` False     containsGraphemeCluster "👎👎👎🏿👎👎👎" `shouldBe` True-    
tinytools.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           tinytools-version:        0.1.0.0+version:        0.1.0.3 description:    Please see the README on GitHub at <https://github.com/pdlla/tinytools#readme> homepage:       https://github.com/pdlla/tinytools#readme bug-reports:    https://github.com/pdlla/tinytools/issues@@ -73,6 +73,7 @@       Potato.Flow.RenderCache       Potato.Flow.SEltMethods       Potato.Flow.SElts+      Potato.Flow.Serialization.Snake       Potato.Flow.TestStates       Potato.Flow.Types   hs-source-dirs:@@ -117,6 +118,7 @@   build-depends:       MonadRandom     , aeson+    , aeson-pretty     , base >=4.7 && <5     , bimap     , binary@@ -151,9 +153,10 @@     , these     , vector     , vty+    , filepath   default-language: Haskell2010 -test-suite potato-flow-test+test-suite tinytools-test   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules: