diff --git a/LysKom/Internal/CodeGen.hs b/LysKom/Internal/CodeGen.hs
index f5a93a65629aee74ab05a9eaeda38dc4773de4af..d35abb1234453af28c7c2cff502e342d2cc34ca4 100644
--- a/LysKom/Internal/CodeGen.hs
+++ b/LysKom/Internal/CodeGen.hs
@@ -3,24 +3,30 @@
module LysKom.Internal.CodeGen where
import Language.Haskell.TH
-import Language.Haskell.TH.Syntax
import LysKom.ProtocolA (documentParser)
import LysKom.ProtocolA.Data (ProtocolAItem (..))
import LysKom.ProtocolA.Types
import Text.ParserCombinators.Parsec (parseFromFile)
-import Data.Either (rights)
-import Data.Char (toUpper)
import Data.Maybe (maybe)
-import Control.Concurrent.Async (Async)
-
import LysKom.LineFormat
import LysKom
-import Data.Int
+import Data.Int (Int32, Int16, Int8)
import qualified Data.List as L
+import Control.Exception (throw, PatternMatchFail (..))
+
+----------------------------------------
+
+import Data.Functor (($>))
+import Data.ByteString.Builder (char7, intDec, string7)
+import Data.List (intersperse)
+import Data.ByteString.Char8 (pack)
+import Data.Attoparsec.ByteString.Char8 (char, string)
+import Data.Attoparsec.ByteString (choice)
+
b = Bang NoSourceUnpackedness NoSourceStrictness
lystype :: LysType -> Type
@@ -32,8 +38,9 @@ lystype FLOAT = ConT ''Float
lystype HOLLERITH = ConT ''String
lystype (ARRAY n) = AppT ListT $ lystype n
lystype (Reference n) = ConT . mkName $ n
--- `lystype _' is intentionally missing. since they should never be
--- able to appear.
+lystype s = throw $
+ PatternMatchFail $ "lystype should NEVER be called on compound types: "
+ ++ show s
derivShow = DerivClause Nothing [ ConT ''Show ]
@@ -66,7 +73,7 @@ f (DerivedType name (ENUMERATION t)) = do
[ derivShow ]
, InstanceD Nothing [] (AppT (ConT ''LineFormat) (ConT className)) $
[ ValD (VarP . mkName $ "decoder")
- (NormalB (AppE (VarE . mkName $ "choice") $ ListE decoderBodies))
+ (NormalB (AppE (VarE 'choice) $ ListE decoderBodies))
[]
, ValD (VarP enc)
(NormalB $ UInfixE (VarE enc)
@@ -126,7 +133,7 @@ f (DerivedType name typ@(STRUCTURE t)) = do
$(return . ListE $ (AppE encode) . VarE <$> gens) |]
let decoder = (VarE . mkName $ "decoder")
- let chr = (AppE (VarE . mkName $ "char") (LitE . CharL $ ' '))
+ let chr = (AppE (VarE 'char) (LitE . CharL $ ' '))
return [ DataD [] n [] Nothing
[RecC n [(mkName n, b, lystype t) | (n, t) <- t]]
[ derivShow ]
@@ -138,7 +145,7 @@ f (DerivedType name typ@(STRUCTURE t)) = do
, FunD (mkName "decoder")
[ Clause []
(NormalB $
- UInfixE (VarE n) (VarE . mkName $ "<$>")
+ UInfixE (ConE n) (VarE . mkName $ "<$>")
$ apInfix (VarE . mkName $ "<*>") $
decoder : (take (length t - 1) $
repeat $
@@ -148,6 +155,7 @@ f (DerivedType name typ@(STRUCTURE t)) = do
[] ] ] ]
+
f (DerivedType name typ@(BITSTRING t)) = do
let n = mkName name
gens <- mapM newName t
@@ -167,7 +175,7 @@ f (DerivedType name typ@(BITSTRING t)) = do
, FunD (mkName "decoder")
[ Clause []
(NormalB $
- UInfixE (VarE n) (VarE . mkName $ "<$>")
+ UInfixE (ConE n) (VarE . mkName $ "<$>")
$ apInfix ap $ take (length t) (repeat decoder))
[] ]]
]
diff --git a/LysKom/Internal/NameTransform.hs b/LysKom/Internal/NameTransform.hs
index fec0728787faad772c0f948a69dda9222ea8dc37..ef76107e4ffea33f69027fd16143f682379e4694 100644
--- a/LysKom/Internal/NameTransform.hs
+++ b/LysKom/Internal/NameTransform.hs
@@ -21,6 +21,11 @@ varname "type" = "type'"
-- rename these and let requests keep their "proper" names
varname "change-name" = "changeName'"
varname "create-conf" = "createConf'"
+-- one would think that (newName s) would produce always produce a
+-- valid name. And (newName "where") pretty prints as where_1, which
+-- seems like a valid name. However, internally the variable is still
+-- named "where", which is an illegal variable name.
+varname "where" = "where'"
varname ('-':c:xs) = toUpper c : varname xs
varname (c:xs) = c : varname xs
diff --git a/LysKom/Types.hs b/LysKom/Types.hs
index f525a30d471af07ab6d30f8ca6abbe4ed47423b5..08b22c56e55c6f7c8d870b50d467b2bdfa258b7c 100644
--- a/LysKom/Types.hs
+++ b/LysKom/Types.hs
@@ -1,31 +1,26 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell #-}
-module Output where
+module LysKom.Types where
-import LineFormat
+import LysKom.LineFormat
import LysKom
-import GHC.Base
-import GHC.Int (Int8, Int16, Int32)
-import GHC.Show
-import GHC.Types (Bool, Float)
-import Data.List (intersperse)
-import Data.ByteString.Builder (char7, intDec)
-import Data.ByteString.Char8 (pack)
-import Data.Functor ((<$>))
-import Data.Either
-
-import Data.Attoparsec.ByteString (choice)
-import Data.Attoparsec.ByteString.Char8 (char, string)
+import LysKom.Internal.CodeGen (f)
+import Language.Haskell.TH (runIO)
+import Language.Haskell.TH.Syntax (sequenceQ)
+import LysKom.ProtocolA (documentParser)
+import Text.ParserCombinators.Parsec (parseFromFile)
---------------------------------------------------
+import Data.Either (rights)
+import Data.List (sortOn)
+import LysKom.Internal.NameTransform (transformTree)
+import LysKom.TypesHelper
-import Test2 (f)
-import Language.Haskell.TH (runQ, runIO)
-import Text.Parsers.ProtocolA (documentParser)
-import Text.ParserCombinators.Parsec (parseFromFile)
+do d <- runIO $ parseFromFile documentParser "/usr/share/doc/lyskom/protocol-a-full.txt"
+ -- let dat = head $ rights [d]
+ let dat = transformTree $ sortOn proc $ head $ rights [d]
-$(do d <- runIO $ parseFromFile documentParser "/usr/share/doc/lyskom/protocol-a-full.txt"
- let dat = head $ rights [d]
- (mconcat <$>) $ Prelude.mapM runQ $ map f dat)
+ let dat' = filter g $ map (enumOf2Enum dat) dat
+ mconcat <$> (sequenceQ $ map f dat')
+ -- (mconcat <$>) $ Prelude.mapM runQ $ map f dat
diff --git a/test.hs b/test.hs
index 9dbc969cf18581a79e45a499cba65c72127d108a..93912de9dd8303702e6ac06b280ddba61e73c15c 100644
--- a/test.hs
+++ b/test.hs
@@ -7,7 +7,8 @@ import Data.Attoparsec.ByteString
import Control.Monad
-import Output
+-- import Output
+import LysKom.Types
req76 :: String -> Builder
req76 s = string7 "76 "