From 46ae60eaca841b554ba20c6a2b7a15b43c12b4df Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 18 Dec 2018 13:51:16 +0100
Subject: Much ado about nothing

---
 interactive-edit-lens/src/Interact/Types.hs | 120 ++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)
 create mode 100644 interactive-edit-lens/src/Interact/Types.hs

(limited to 'interactive-edit-lens/src/Interact')

diff --git a/interactive-edit-lens/src/Interact/Types.hs b/interactive-edit-lens/src/Interact/Types.hs
new file mode 100644
index 0000000..a4d08ac
--- /dev/null
+++ b/interactive-edit-lens/src/Interact/Types.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Interact.Types
+  ( InteractName(..)
+  , _LeftEditor, _RightEditor, _PrimitiveName
+  , Validity, pattern Valid, pattern Invalid
+  , InteractState(..)
+  , HasLeft(..), HasRight(..), HasComplement(..), HasFocus(..), HasFocused(..)
+  , InteractInitial(..)
+  , _InitialLeft, _InitialRight, _InitialEmpty
+  , InteractConfig(..)
+  , HasInitial(..), HasLens(..), HasCompileError(..)
+  , InteractEvent
+  , InteractApp
+  , InteractDirection(..)
+  , charseq
+  , WithName(..)
+  , module Control.Edit
+  , module Control.Lens.Edit
+  , module Control.DFST.Lens
+  , module Data.Semigroup
+  , module Numeric.Natural
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Text.Lens
+
+import Data.Sequence (Seq(..))
+import qualified Data.Sequence as Seq
+
+import qualified Data.Foldable as Foldable
+
+import Data.Semigroup (Semigroup(..), Last(..))
+import Numeric.Natural
+
+import Brick
+import Brick.Focus
+import Brick.Widgets.Edit
+
+import Control.Lens
+import Control.Lens.TH
+import Control.Edit
+import Control.Lens.Edit
+import Control.DFST.Lens
+
+import Data.Text.Zipper.Generic
+
+
+data InteractName
+  = LeftEditor
+  | RightEditor
+  | PrimitiveName !Text
+  deriving (Eq, Ord, Show, Read)
+
+makePrisms ''InteractName
+
+type Validity = Bool
+pattern Valid = True
+pattern Invalid = False
+
+data InteractState c = InteractState
+  { istLeft, istRight :: (Last Validity, Last (Seq Char, Int), StringEdits Natural Char)
+  , istComplement :: c
+  , istFocus :: FocusRing InteractName
+  }
+
+makeLensesWith abbreviatedFields ''InteractState
+
+class HasFocused s a | s -> a where
+  focused :: Traversal' s a
+
+instance HasFocused (InteractState c) (Last Validity, Last (Seq Char, Int), StringEdits Natural Char) where
+  focused f st@InteractState{..} = case focusGetCurrent istFocus of
+    Just LeftEditor  -> left f st
+    Just RightEditor -> right f st
+    _other           -> pure st
+
+data InteractInitial
+  = InitialLeft Text
+  | InitialRight Text
+  | InitialEmpty
+  deriving (Eq, Ord, Show, Read)
+
+makePrisms ''InteractInitial
+
+data InteractConfig c = InteractConfig
+  { icfgInitial :: InteractInitial
+  , icfgLens :: EditLens c (StringEdits Natural Char) (StringEdits Natural Char)
+  , icfgCompileError :: Maybe String
+  }
+
+instance HasEditLens (InteractConfig c) (StringEdits Natural Char) (StringEdits Natural Char) where
+  type Complement (InteractConfig c) = c
+  ground = ground . icfgLens
+  propR = propR . icfgLens
+  propL = propL . icfgLens
+
+makeLensesWith abbreviatedFields ''InteractConfig
+
+charseq :: Iso' Text (Seq Char)
+charseq = iso Text.unpack Text.pack . iso Seq.fromList Foldable.toList
+
+type InteractEvent = ()
+
+type InteractApp c = App (InteractState c) InteractEvent InteractName
+
+data InteractDirection = PropagateLeft | PropagateRight
+  deriving (Eq, Ord, Enum, Bounded, Show, Read)
+
+makePrisms ''InteractDirection
+
+
+infixr 1 `WithName`
+data WithName x n = WithName x n
+  deriving (Eq, Ord, Show, Read)
+
+instance Named (x `WithName` n) n where
+  getName (_ `WithName` n) = n
-- 
cgit v1.2.3