haskell: some abstractions compile

.gitignore

@@ -4,6 +4,7 @@
 
 .#*
 build
+/haskell/**/dist-newstyle
 /rust/target
 result
 result-*

haskell/nfker7h/lib/Language/Yanais/Fusion.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Language.Yanais.Fusion (
+    Step(..),
+    stepState,
+    StepFun(..),
+    Stream,
+    embedTfs
+) where
+
+import Data.Bifunctor
+import qualified Data.Text.Internal.Fusion as TF
+
+data Step s a = Done | Skip !s | Yield !a !s
+
+instance Functor (Step s) where
+    fmap _ Done = Done
+    fmap _ (Skip s) = Skip s
+    fmap f (Yield a s) = Yield (f a) s
+
+instance Bifunctor Step where
+    bimap _ _ Done = Done
+    bimap f _ (Skip s) = Skip (f s)
+    bimap f g (Yield a s) = Yield (g a) (f s)
+
+stepState :: Step s a -> Maybe s
+stepState Done = Nothing
+stepState (Skip st) = Just st
+stepState (Yield _ st) = Just st
+
+data StepFun s a = StepFun (s -> Step s a)
+
+instance Functor (StepFun s) where
+    fmap f inif = inif >>= (\x -> pure (f x))
+
+instance Applicative (StepFun s) where
+    pure x = StepFun (\st -> Yield x st)
+
+    f <*> v = f >>= (\fx -> v >>= (\vx -> StepFun $ Yield (fx vx)))
+
+instance Monad (StepFun s) where
+    return = pure
+    (StepFun f1) >>= f2 = StepFun go
+      where
+        go st = case f1 st of
+          Done -> Done
+          Skip st2 -> Skip st2
+          Yield x st2 -> let (StepFun f3) = (f2 x) in f3 st2
+
+data Stream a = forall s. Stream
+    (StepFun s a)   -- stepper function
+    !s              -- current state
+
+instance Functor Stream where
+    fmap f (Stream step cst) = Stream (fmap f step) cst
+
+smap :: TF.Step s a -> Step s a
+smap  TF.Done         = Done
+smap (TF.Skip st)     = Skip st
+smap (TF.Yield av st) = Yield av st
+
+embedTfs :: TF.Stream x -> Stream x
+embedTfs (TF.Stream step st _) = Stream (StepFun (smap . step)) st

haskell/nfker7h/lib/Language/Yanais/Nfker7h/Parser/Fusion.hs

@@ -1,54 +0,0 @@
-module Language.Yanais.Nfker7h.Parser.Fusion (
-    Step(*),
-    StepFun(*),
-    Stream,
-    embedTfs
-) where
-
-import Data.Bifunctor
-import Data.Text.Internal.Fusion as TF
-import Prolens
-
-data Step s a = Done | Skip !s | Yield !a !s
-
-instance Functor (Step s) where
-    fmap f Done = Done
-    fmap f (Skip s) = Skip s
-    fmap f (Yield a s) = Yield (f a) s
-
-instance Bifunctor Step where
-    bimap f g Done = Done
-    bimap f g (Skip s) = Skip (f s)
-    bimap f g (Yield a s) = Yield (g a) (f s)
-
-data StepFun s a = StepFun (s -> Step s a)
-
-instance Functor (StepFun s) where
-    fmap f inif = inif >>= (\x -> pure (f x))
-
-instance Applicative (StepFun s) where
-    pure x = StepFun (\st -> Yield st x)
-    f <*> v = f >>= (\fx -> v >>= (\vx -> StepFun (\st -> fx vx)))
-
-instance Monad (StepFun s) where
-    return = pure
-    (StepFun f1) >>= f2 = StepFun go
-      where
-        go st = case f1 st of
-          Done -> Done
-          Skip st2 -> Skip st2
-          Yield x st2 -> f2 x st2
-
-liftLens :: Lens' source a -> Lens' (StepFun 
-
-data StreamInner s a = StreamInner
-    (StepFun s a)   -- stepper function
-    !s              -- current state
-
-type Stream a = forall s. StreamInner s a
-
-instance Functor (StreamInner s) where
-    fmap f (Stream step cst) = Stream (fmap f step) cst
-
-embedTfs :: TF.Stream x -> Stream x
-embedTfs (TF.Stream step st) = Stream (StepFun step) st

haskell/nfker7h/lib/Language/Yanais/Nfker7h/Parser/Lex.hs

@@ -2,15 +2,15 @@
 
 module Language.Yanais.Nfker7h.Parser.Lex (
     Token,
-    TokenKind(*),
-    Keyword(*),
+    TokenKind(..),
+    Keyword(..),
     lex,
 ) where
 
 import Control.Monad.State.Strict
 import Data.Bifunctor
 import Data.Char
-import Data.Either (Either(*))
+import Data.Either (Either(..))
 import qualified Data.Text as T
 import Data.Text.ICU.Char (Bool_, property)
 import Data.Text.Internal.Fusion as TF
@@ -49,14 +49,17 @@ data Lexer = Lexer {
 
 type LexerMonad a = StateT !Int (Either (Span, Error) a)
 
+type LexerStep = Lexer -> Step Lexer Char
+
 lex :: T.Text -> Stream (Either (Span, Error) Token)
 lex t = Stream step (Lexer { lexOffset = 0, lexS = liftTfs (stream t) })
   where
     stepi :: Lexer -> Step Lexer Char
     stepi lxr = first (\st -> lxr { lexS = st }) (lexS lxr)
     step :: Lexer -> Step Lexer (Either (Span, Error) Token)
-    
 
+-- sublexers
+lexString 
 
 lex :: T.Text -> LexerMonad [Token]
 lex t = T.foldl' (return []) go t

haskell/nfker7h/lib/Language/Yanais/Nfker7h/Parser/Types.hs

@@ -1,15 +1,18 @@
+{-# LANGUAGE DeriveGeneric #-}
+
 module Language.Yanais.Nfker7h.Parser.Types (
-    Span(*),
+    Span(..),
     Ident,
-    Context(*),
-    Result(*),
-    Error(*),
+    Context(..),
+    Result(..),
+    Error(..),
     MaybeGetSpan
 ) where
 
 import Control.DeepSeq (NFData)
 import Data.Hashable (Hashable)
 import qualified Data.Text as T
+import Generic.Data
 
 -- A 0-indexed, half-open interval of integers, defined by start & end indices
 data Span = Span
@@ -24,17 +27,14 @@ instance NFData   Span
 instance Semigroup Span where
   Span start1 end1 <> Span start2 end2 = Span (min start1 start2) (max end1 end2)
 
-instance Lower Span where
-  lowerBound = Span 0 0
-
-type Ident = Ident T.Text
+data Ident = Ident T.Text
 
 -- a "classic" tristate result
-type Result t = RSome t | RNone | RError Span Error
+data Result t = RSome t | RNone | RError Span Error
 
-type Context = CtxModule
+data Context = CtxModule
 
-type Error = UnexpectedEof Context
+data Error = UnexpectedEof Context
     | UnknownIdent Ident
 
 instance Functor Result where
@@ -61,9 +61,15 @@ class MaybeGetSpan a where
 
 instance MaybeGetSpan t => MaybeGetSpan (Result t) where
     mgSpan (RSome x)    = mgSpan x
-    mgSpan RNone        = None
+    mgSpan RNone        = Nothing
     mgSpan (RError s _) = Just s
 
+instance Show Ident where
+    show (Ident x) = show x
+
+instance Show Context where
+    show CtxModule = "module level"
+
 instance Show Error where
     show (UnexpectedEof ctx) = "end of file encountered inside " <> show ctx
     show (UnknownIdent x) = "unknown identifier " <> show x

haskell/nfker7h/yanais-nfker7h.cabal

@@ -52,30 +52,37 @@ extra-doc-files:    CHANGELOG.md
 -- extra-source-files:
 
 common warnings
-    ghc-options: -Wall
+    ghc-options: -W -Wall
 
 library
     -- Import common warning flags.
     import:           warnings
 
     -- Modules exported by the library.
-    exposed-modules:  Language.Yanais.Nfker7h.Parser.Lex
+    exposed-modules:
+        Language.Yanais.Fusion
+      , Language.Yanais.Nfker7h.Parser.Types
+      , Language.Yanais.Nfker7h.Parser.Lex
 
     -- Modules included in this library but not exported.
     -- other-modules:
 
     -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
+    other-extensions:
+        DeriveGeneric
+        ExistentialQuantification
+        OverloadedStrings
+        RankNTypes
 
     -- Other library packages from which modules are imported.
     build-depends:
         base         ^>= 4.17.2.0
-        deepseq      (>= 1.1 && <1.6)
-        mtl          ^>= 2.3.1
-        prolens      ^>= 0.0.0.0
-        semilattices (>= 0.0.0.3 && <0.1)
-        text         ^>= 2.1
-        text-icu     ^>= 0.8.0.0
+      , deepseq      (>= 1.1 && <1.6)
+      , generic-data ^>= 1.1.0.0
+      , hashable     ^>= 1.4.3.0
+      , mtl          ^>= 2.3.1
+      , text         ^>= 2.1
+      , text-icu     ^>= 0.8.0.0
 
     -- build-tools:      alex