iface: rename `Symantic.{View => Viewer}`

diff --git a/src/Symantic.hs b/src/Symantic.hs
index eee81c1edc1fb955d0579dc94297c46e84cd59c4..64bc821fedc470a796f43527be555db2a25d0219 100644 (file)
--- a/src/Symantic.hs
+++ b/src/Symantic.hs
@@ -1,19 +1,19 @@
 module Symantic
- ( module Symantic.Class
+ ( module Symantic.Classes
  , module Symantic.CurryN
  , module Symantic.Data
  , module Symantic.Derive
- , module Symantic.ObserveSharing
  , module Symantic.Optimize
  , module Symantic.Reify
- , module Symantic.View
+ , module Symantic.SharingObserver
+ , module Symantic.Viewer
  ) where
 
-import Symantic.Class
+import Symantic.Classes
 import Symantic.CurryN
 import Symantic.Data
 import Symantic.Derive
-import Symantic.ObserveSharing
 import Symantic.Optimize
 import Symantic.Reify
-import Symantic.View
+import Symantic.SharingObserver
+import Symantic.Viewer

diff --git a/src/Symantic/View.hs b/src/Symantic/View.hs
deleted file mode 100644 (file)
index 7a4c97c..0000000
--- a/src/Symantic/View.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-{-# LANGUAGE GADTs #-} -- For View
-{-# LANGUAGE OverloadedStrings #-} -- For convenience
-{-# LANGUAGE UndecidableInstances #-} -- For Show (SomeData a)
-module Symantic.View where
-
-import Data.Int (Int)
-import Data.String
-import Text.Show
-import qualified Data.Function as Fun
-import qualified Prelude
-
-import Symantic.Class
-import Symantic.Data
-import Symantic.Derive
-import Symantic.Fixity
-
-data View a where
-  View :: (ViewEnv -> ShowS) -> View a
-  ViewUnifix :: Unifix -> String -> String -> View (a -> b)
-  ViewInfix :: Infix -> String -> String -> View (a -> b -> c)
-  ViewApp :: View (b -> a) -> View b -> View a
-
-runView :: View a -> ViewEnv -> ShowS
-runView (View v) env = v env
-runView (ViewInfix _op name _infixName) _env = showString name
-runView (ViewUnifix _op name _unifixName) _env = showString name
-runView (ViewApp f x) env =
-  pairView env op Fun.$
-    runView f env{viewEnv_op = (op, SideL) } Fun..
-    showString " " Fun..
-    runView x env{viewEnv_op = (op, SideR) }
-  where op = infixN 10
-
--- | Unusual, but enables to leverage default definition of methods.
-type instance Derived View = View
-instance LiftDerived View where
-  liftDerived = Fun.id
-
-instance IsString (View a) where
-  fromString s = View Fun.$ \_env -> showString s
-instance Show (View a) where
-  showsPrec p = (`runView` ViewEnv
-    { viewEnv_op = (infixN p, SideL)
-    , viewEnv_pair = pairParen
-    , viewEnv_lamDepth = 1
-    })
-instance Show (SomeData View a) where
-  showsPrec p (SomeData x) = showsPrec p (derive x :: View a)
-
-data ViewEnv
-  = ViewEnv
-  { viewEnv_op :: (Infix, Side)
-  , viewEnv_pair :: Pair
-  , viewEnv_lamDepth :: Int
-  }
-
-pairView :: ViewEnv -> Infix -> ShowS -> ShowS
-pairView env op s =
-  if isPairNeeded (viewEnv_op env) op
-  then showString o Fun.. s Fun.. showString c
-  else s
-  where (o,c) = viewEnv_pair env
-
-instance Abstractable View where
-  var = Fun.id
-  lam f = viewLam "x" f
-  lam1 f = viewLam "u" f
-  ViewInfix op _name infixName .@ ViewApp x y = View Fun.$ \env ->
-    pairView env op Fun.$
-      runView x env{viewEnv_op=(op, SideL)} Fun..
-      showString " " Fun.. showString infixName Fun.. showString " " Fun..
-      runView y env{viewEnv_op=(op, SideR)}
-  ViewInfix op name _infixName .@ x = View Fun.$ \env ->
-    showParen Prelude.True Fun.$
-      runView x env{viewEnv_op=(op, SideL)} Fun..
-      showString " " Fun.. showString name
-  f .@ x = ViewApp f x
-viewLam :: String -> (View a -> View b) -> View (a -> b)
-viewLam varPrefix f = View Fun.$ \env ->
-  pairView env op Fun.$
-    let x = showString varPrefix Fun..
-            showsPrec 0 (viewEnv_lamDepth env) in
-    -- showString "Lam1 (" .
-    showString "\\" Fun.. x Fun.. showString " -> " Fun..
-    runView (f (View (\_env -> x))) env
-      { viewEnv_op = (op, SideL)
-      , viewEnv_lamDepth = Prelude.succ (viewEnv_lamDepth env)
-      }
-    -- . showString ")"
-  where
-  op = infixN 0
-instance Anythingable View
-instance Bottomable View where
-  bottom = "<hidden>"
-instance Show c => Constantable c View where
-  constant c = View Fun.$ \_env -> shows c
-instance Eitherable View where
-  left = "Left"
-  right = "Right"
-instance Equalable View where
-  equal = ViewInfix (infixN 4) "(==)" "=="
-instance Listable View where
-  cons = ViewInfix (infixR 5) "(:)" ":"
-  nil = "[]"
-instance Maybeable View where
-  nothing = "Nothing"
-  just = "Just"

diff --git a/src/Symantic/Viewer.hs b/src/Symantic/Viewer.hs
new file mode 100644 (file)
index 0000000..688bb0b
--- /dev/null
+++ b/src/Symantic/Viewer.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE GADTs #-} -- For Viewer
+{-# LANGUAGE OverloadedStrings #-} -- For convenience
+{-# LANGUAGE UndecidableInstances #-} -- For Show (SomeData a)
+module Symantic.Viewer where
+
+import Data.Int (Int)
+import Data.String
+import Text.Show
+import qualified Data.Function as Fun
+import qualified Prelude
+
+import Symantic.Classes
+import Symantic.Data
+import Symantic.Derive
+import Symantic.Fixity
+
+data Viewer a where
+  Viewer :: (ViewerEnv -> ShowS) -> Viewer a
+  ViewerUnifix :: Unifix -> String -> String -> Viewer (a -> b)
+  ViewerInfix :: Infix -> String -> String -> Viewer (a -> b -> c)
+  ViewerApp :: Viewer (b -> a) -> Viewer b -> Viewer a
+
+runViewer :: Viewer a -> ViewerEnv -> ShowS
+runViewer (Viewer v) env = v env
+runViewer (ViewerInfix _op name _infixName) _env = showString name
+runViewer (ViewerUnifix _op name _unifixName) _env = showString name
+runViewer (ViewerApp f x) env =
+  pairViewer env op Fun.$
+    runViewer f env{viewEnv_op = (op, SideL) } Fun..
+    showString " " Fun..
+    runViewer x env{viewEnv_op = (op, SideR) }
+  where op = infixN 10
+
+-- | Unusual, but enables to leverage default definition of methods.
+type instance Derived Viewer = Viewer
+instance LiftDerived Viewer where
+  liftDerived = Fun.id
+
+instance IsString (Viewer a) where
+  fromString s = Viewer Fun.$ \_env -> showString s
+instance Show (Viewer a) where
+  showsPrec p = (`runViewer` ViewerEnv
+    { viewEnv_op = (infixN p, SideL)
+    , viewEnv_pair = pairParen
+    , viewEnv_lamDepth = 1
+    })
+instance Show (SomeData Viewer a) where
+  showsPrec p (SomeData x) = showsPrec p (derive x :: Viewer a)
+
+data ViewerEnv
+  = ViewerEnv
+  { viewEnv_op :: (Infix, Side)
+  , viewEnv_pair :: Pair
+  , viewEnv_lamDepth :: Int
+  }
+
+pairViewer :: ViewerEnv -> Infix -> ShowS -> ShowS
+pairViewer env op s =
+  if isPairNeeded (viewEnv_op env) op
+  then showString o Fun.. s Fun.. showString c
+  else s
+  where (o,c) = viewEnv_pair env
+
+instance Abstractable Viewer where
+  var = Fun.id
+  lam f = viewLam "x" f
+  lam1 f = viewLam "u" f
+  ViewerInfix op _name infixName .@ ViewerApp x y = Viewer Fun.$ \env ->
+    pairViewer env op Fun.$
+      runViewer x env{viewEnv_op=(op, SideL)} Fun..
+      showString " " Fun.. showString infixName Fun.. showString " " Fun..
+      runViewer y env{viewEnv_op=(op, SideR)}
+  ViewerInfix op name _infixName .@ x = Viewer Fun.$ \env ->
+    showParen Prelude.True Fun.$
+      runViewer x env{viewEnv_op=(op, SideL)} Fun..
+      showString " " Fun.. showString name
+  f .@ x = ViewerApp f x
+viewLam :: String -> (Viewer a -> Viewer b) -> Viewer (a -> b)
+viewLam varPrefix f = Viewer Fun.$ \env ->
+  pairViewer env op Fun.$
+    let x = showString varPrefix Fun..
+            showsPrec 0 (viewEnv_lamDepth env) in
+    -- showString "Lam1 (" .
+    showString "\\" Fun.. x Fun.. showString " -> " Fun..
+    runViewer (f (Viewer (\_env -> x))) env
+      { viewEnv_op = (op, SideL)
+      , viewEnv_lamDepth = Prelude.succ (viewEnv_lamDepth env)
+      }
+    -- . showString ")"
+  where
+  op = infixN 0
+instance Anythingable Viewer
+instance Bottomable Viewer where
+  bottom = "<hidden>"
+instance Show c => Constantable c Viewer where
+  constant c = Viewer Fun.$ \_env -> shows c
+instance Eitherable Viewer where
+  left = "Left"
+  right = "Right"
+instance Equalable Viewer where
+  equal = ViewerInfix (infixN 4) "(==)" "=="
+instance Listable Viewer where
+  cons = ViewerInfix (infixR 5) "(:)" ":"
+  nil = "[]"
+instance Maybeable Viewer where
+  nothing = "Nothing"
+  just = "Just"

diff --git a/symantic-base.cabal b/symantic-base.cabal
index d4771951d407ae6c676a30447cb35b9eb4c07f48..1cb5fe38d6e959dbcc054bbb88d1338a1c8e34e7 100644 (file)
--- a/symantic-base.cabal
+++ b/symantic-base.cabal
@@ -38,8 +38,8 @@ description:
     only polymorphic types (possibly constrained)
     or functions using such types.
     Inspired by Oleg Kiselyov's [TDPE.hs](http://okmij.org/ftp/tagless-final/course/TDPE.hs).
-  * @Symantic.View@
-    interprets combinators as a human-readable string.
+  * @Symantic.Viewer@
+    interprets combinators as human-readable text.
   * @Symantic.ADT@
     enables to derive reciprocal functions between
     algebraic data type constructors and @Either@s of tuples.
@@ -78,7 +78,7 @@ library
     Symantic.Optimize
     Symantic.Reify
     Symantic.SharingObserver
-    Symantic.View
+    Symantic.Viewer
   default-language: Haskell2010
   default-extensions:
     DefaultSignatures