Rename Col to ColType

Rename Col to ColType

Signed-off-by: Joern Bernhardt <7b85a41a628204b76aba4326273a3ccc74bd009a@campudus.com>

module Tab
  ( Cell
  ) where

import Prelude
import Data.Maybe (Maybe(..))
import Data.Vec
import Data.List
import Data.Typelevel.Num

class ColType a where
  kind :: a

instance stringCol :: ColType String where
  kind = ""

type Cell a = Maybe a

class Conv a where
  conv :: ColType a => a -> Cell a

instance convAny :: Conv a where
  conv x = Just x

newtype Table size cols cells = Table
  { columns :: Vec size cols
  , rows :: List (Vec size cells)
  }

module Tab
  ( Cell
  ) where

import Prelude
import Data.Maybe (Maybe(..))
import Data.Vec
import Data.List
import Data.Typelevel.Num

class Col a where
  kind :: a

instance stringCol :: Col String where
  kind = ""

type Cell a = Maybe a

class Conv a where
  conv :: Col a => a -> Cell a

instance convAny :: Conv a where
  conv x = Just x

newtype Table size cols cells = Table
  { columns :: Vec size cols
  , rows :: List (Vec size cells)
  }


Update classes

Update classes

module Data.Either where

  import Prelude

  data Either a b = Left a | Right b

  either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c
  either f _ (Left a) = f a
  either _ g (Right b) = g b

  isLeft :: forall a b. Either a b -> Boolean
  isLeft = either (const true) (const false)

  isRight :: forall a b. Either a b -> Boolean
  isRight = either (const false) (const true)

  instance functorEither :: Functor (Either a) where
    (<$>) _ (Left x) = Left x
    (<$>) f (Right y) = Right (f y)

  instance applyEither :: Apply (Either e) where
    (<*>) (Left e) _ = Left e
    (<*>) (Right f) r = f <$> r

  instance applicativeEither :: Applicative (Either e) where
    pure = Right

  instance bindEither :: Bind (Either e) where
    (>>=) = either (\e _ -> Left e) (\a f -> f a)

  instance monadEither :: Monad (Either e)

  instance showEither :: (Show a, Show b) => Show (Either a b) where
    show (Left x) = "Left " ++ (show x)
    show (Right y) = "Right " ++ (show y)

  instance eqEither :: (Eq a, Eq b) => Eq (Either a b) where
    (==) (Left a1) (Left a2) = a1 == a2
    (==) (Right b1) (Right b2) = b1 == b2
    (==) _ _ = false
    (/=) a b = not (a == b)

module Data.Either where

  import Prelude

  data Either a b = Left a | Right b

  either :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c
  either f _ (Left a) = f a
  either _ g (Right b) = g b

  isLeft :: forall a b. Either a b -> Boolean
  isLeft = either (const true) (const false)

  isRight :: forall a b. Either a b -> Boolean
  isRight = either (const false) (const true)

  instance monadEither :: Monad (Either e) where
    return = Right
    (>>=) = either (\e _ -> Left e) (\a f -> f a)

  instance applicativeEither :: Applicative (Either e) where
    pure = Right
    (<*>) (Left e) _ = Left e
    (<*>) (Right f) r = f <$> r

  instance functorEither :: Functor (Either a) where
    (<$>) _ (Left x) = Left x
    (<$>) f (Right y) = Right (f y)

  instance showEither :: (Show a, Show b) => Show (Either a b) where
    show (Left x) = "Left " ++ (show x)
    show (Right y) = "Right " ++ (show y)

  instance eqEither :: (Eq a, Eq b) => Eq (Either a b) where
    (==) (Left a1) (Left a2) = a1 == a2
    (==) (Right b1) (Right b2) = b1 == b2
    (==) _ _ = false
    (/=) a b = not (a == b)


Removes meta-database functions.

Removes meta-database functions.

The reason for their removal is that it's almost impossible to codify all
possible database creation options (in fact, prior to their removal, they
didn't include said options at all). Now it's entirely possible that we could
have implemented some sane base-level of options for database creation, but in
addition to the former, semantically speaking, the typeclass should only be
responsible for the data inside of it: that is - its collections. Therefore,
functions that create, get and delete collections inside of a database were
left in, but "meta-database" functions that operate on the database itself were
removed.

It can be argued that Actors can control their own creation, deletion, etc..,
but for the time being, I have decided that `Database` is not a total Actor.

module Abstract.Database
	( DATABASE
	, CollectionImpl
	, Collection
	, Pagination
	, limit
	, skip
	, SortOrder
	, asc
	, desc
	, sortOrder
	, getClauseType
	, Clause
	, clause
	, LogicConnector
	, logicConnector
	, Predicate
	, SQL
	, Native
	, Query
	, ordering
	, equals'
	, equals'Flipped
	, (==..)
	, equals
	, equalsFlipped
	, (==.)
	, notEquals'
	, notEquals'Flipped
	, (/=..)
	, (!=..)
	, notEquals
	, notEqualsFlipped
	, (/=.)
	, (!=.)
	, lessThan'
	, lessThan'Flipped
	, (<..)
	, lessThan
	, lessThanFlipped
	, (<.)
	, lessThanOrEquals'
	, lessThanOrEquals'Flipped
	, (<=..)
	, lessThanOrEquals
	, lessThanOrEqualsFlipped
	, (<=.)
	, greaterThan'
	, greaterThan'Flipped
	, (>..)
	, greaterThan
	, greaterThanFlipped
	, (>.)
	, greaterThanOrEquals'
	, greaterThanOrEquals'Flipped
	, (>=..)
	, greaterThanOrEquals
	, greaterThanOrEqualsFlipped
	, (>=.)
	, sortBy'
	, sortBy
	, custom'
	, custom
	, class Database
	, createCollection
	, getCollection
	, deleteCollection
	, getWhere
	, getWhere'
	, countWhere
	, insert
	, insert'
	, deleteWhere
	) where

import Prelude
	( class Eq
	, class Functor
	, class Ord
	, class Semigroup
	, class Show
	, Ordering(EQ, GT, LT)
	, Unit
	, compare
	, flip
	, map
	, negate
	, show
	, ($)
	, (<>)
	, (==)
	, (<<<)
	, (>>>)
	)

import Control.Alt            (class Alt, (<|>))
import Control.Monad.Eff      (Eff)
import Control.Monad.Eff.Ref  (REF, Ref)
import Data.Foreign           (Foreign)
import Data.Foreign.Class     (class AsForeign, class IsForeign, write)
import Data.Foreign.Undefined (writeUndefined)
import Data.Either            (Either(Left, Right))
import Data.List              (List, singleton, uncons)
import Data.Maybe             (Maybe(Just, Nothing))
import Data.Monoid            (class Monoid, mempty)
import Unsafe.Coerce          (unsafeCoerce)

foreign import data DATABASE       :: !
foreign import data CollectionImpl :: *

type Collection t = { collectionImpl :: CollectionImpl }

newtype Pagination = Pagination
	{ skip   :: Maybe Int
	, limit  :: Maybe Int
	}

instance showPagination :: Show Pagination where
	show (Pagination p) = "(Pagination {"
		<> " skip: "   <> show p.skip
		<> ", limit: " <> show p.limit
		<> " })"

instance eqPagination :: Eq Pagination where
	eq p1 p2 = show p1 == show p2

instance ordPagination :: Ord Pagination where
	compare p1 p2 = compare (show p1) (show p2)

instance semigroupPagination :: Semigroup Pagination where
	append (Pagination p1) (Pagination p2) = Pagination
		{ skip: p2.skip     <|> p1.skip   <|> Nothing
		, limit : p2.limit  <|> p1.limit  <|> Nothing
		}

defPagination :: { skip :: Maybe Int, limit :: Maybe Int }
defPagination =
	{ skip : Nothing
	, limit: Nothing
	}

instance monoidPagination :: Monoid Pagination where
	mempty = Pagination defPagination

limit :: Int -> Maybe Pagination
limit l = Just $ Pagination defPagination { limit = Just l }

skip :: Int -> Maybe Pagination
skip o = Just $ Pagination defPagination { skip = Just o }

data SortOrder = Ascending | Descending

instance showSortOrder :: Show SortOrder where
	show Ascending  = "Ascending"
	show Descending = "Descending"

instance eqSortOrder :: Eq SortOrder where
	eq Ascending  Ascending  = true
	eq Descending Descending = true
	eq _          _          = false

instance ordSortOrder :: Ord SortOrder where
	compare Descending Ascending  = LT
	compare Ascending  Descending = GT
	compare _          _          = EQ

asc :: SortOrder
asc = Ascending

desc :: SortOrder
desc = Descending

sortOrder:: { asc :: SortOrder, desc :: SortOrder }
sortOrder =
	{ asc : Ascending
	, desc: Descending
	}

data Clause = Equals
	    | NotEquals
	    | LessThan
	    | LessThanOrEquals
	    | GreaterThan
	    | GreaterThanOrEquals
	    | SortBy SortOrder
	    | Custom String -- ^ The name of the custom clause.
	    | Negate Clause

instance showClause :: Show Clause where
	show Equals              = "Equals"
	show NotEquals           = "NotEquals"
	show LessThan            = "LessThan"
	show LessThanOrEquals    = "LessThanOrEquals"
	show GreaterThan         = "GreaterThan"
	show GreaterThanOrEquals = "GreaterThanOrEquals"
	show (SortBy s)          = "SortBy (" <> show s <> ")"
	show (Custom c)          = "Custom (" <> show c <> ")"
	show (Negate c)          = "Negate (" <> show c <> ")"

instance eqClause :: Eq Clause where
	eq c1 c2 = show c1 == show c2

getClauseType :: Clause -> String
getClauseType Equals              = "Equals"
getClauseType NotEquals           = "NotEquals"
getClauseType LessThan            = "LessThan"
getClauseType LessThanOrEquals    = "LessThanOrEquals"
getClauseType GreaterThan         = "GreaterThan"
getClauseType GreaterThanOrEquals = "GreaterThanOrEquals"
getClauseType (SortBy _)          = "SortBy"
getClauseType (Custom _)          = "Custom"
getClauseType (Negate _)          = "Negate"

clause :: { equals              :: String
	  , notEquals           :: String
	  , lessThan            :: String
	  , lessThanOrEquals    :: String
	  , greaterThan         :: String
	  , greaterThanOrEquals :: String
	  , sortBy              :: String
	  , custom              :: String
	  , negate              :: String
	  }
clause =
	{ equals             : getClauseType Equals
	, notEquals          : getClauseType NotEquals
	, lessThan           : getClauseType LessThan
	, lessThanOrEquals   : getClauseType LessThanOrEquals
	, greaterThan        : getClauseType GreaterThan
	, greaterThanOrEquals: getClauseType GreaterThanOrEquals
	, sortBy             : getClauseType $ SortBy desc
	, custom             : getClauseType $ Custom mempty
	, negate             : getClauseType $ Negate Equals
	}

data LogicConnector = And | Or

logicConnector :: { and :: LogicConnector, or :: LogicConnector }
logicConnector =
	{ and: And
	, or : Or
	}

instance showLogicConnector :: Show LogicConnector where
	show And = "And"
	show Or  = "Or"

instance eqLogicConnector :: Eq LogicConnector where
	eq And And = true
	eq Or  Or  = true
	eq _   _   = false

type Predicate t =
	{ clause         :: Clause
	, logicConnector :: LogicConnector
	, clauseValue    :: Foreign
	, predicate      :: Either String (t -> Foreign)
	}

showPredicate :: forall t. Predicate t -> String
showPredicate p = "({"
	<> " clause: "          <> show p.clause
	<> ", logicConnector: " <> show p.logicConnector
	<> ", clauseValue: "    <> "(IsForeign a)"
	<> ", predicate: "      <> "(t -> (IsForeign a))"
	<> " })"

data SQL
data Native

data Query datastore t = Query (List (Predicate t))

instance showQuery :: Show (Query datastore t) where
	show (Query l) =
		"(Query (datastore) " <> show (map showPredicate l) <> ")"

instance semigroupQuery :: Semigroup (Query datastore t) where
	append (Query l1) (Query l2) = Query (l1 <> l2)

instance monoidQuery :: Monoid (Query datastore t) where
	mempty = Query mempty

instance functorQuery :: Functor (Query datastore) where
	map _ q = unsafeCoerce q -- Father, forgive me.

instance altQuery :: Alt (Query datastore) where
	alt (Query l1) (Query l2) =
		case uncons l2 of
			Just { head, tail } ->
				Query (l1 <> connectorToOr head <> tail)
			Nothing             -> Query l1
		where
			connectorToOr = singleton <<< _ { logicConnector = Or }

orderingToInt :: Ordering -> Int
orderingToInt LT = -1
orderingToInt EQ = 0
orderingToInt GT = 1

ordering :: { lt :: Int, eq :: Int, gt :: Int }
ordering =
	{ lt: orderingToInt LT
	, eq: orderingToInt EQ
	, gt: orderingToInt GT
	}

leftPredicate :: forall t a datastore. (AsForeign a) =>
		 Clause                              ->
		 a                                   ->
		 String                              ->
		 Query datastore t
leftPredicate clause_ clauseValue fieldName = Query $ singleton $
	{ clause        : clause_
	, logicConnector: And
	, clauseValue   : write clauseValue
	, predicate     : Left fieldName
	}

rightPredicate :: forall t a datastore. (AsForeign a) =>
		  Clause                              ->
		  a                                   ->
		  (t -> a)                            ->
		  Query datastore t
rightPredicate clause_ clauseValue fn = Query $ singleton $
	{ clause        : clause_
	, logicConnector: And
	, clauseValue   : write clauseValue
	, predicate     : Right (fn >>> write)
	}

equals' :: forall t e. (AsForeign e, Eq e) => e -> String -> Query SQL t
equals' = leftPredicate Equals

equals'Flipped :: forall t e. (AsForeign e, Eq e) =>
		  String                          ->
		  e                               ->
		  Query SQL t
equals'Flipped = flip equals'
infix 4 equals'Flipped as ==..

equals :: forall t e. (AsForeign e, Eq e) => e -> (t -> e) -> Query Native t
equals = rightPredicate Equals

equalsFlipped :: forall t e. (AsForeign e, Eq e) =>
		 (t -> e)                        ->
		 e                               ->
		 Query Native t
equalsFlipped = flip equals
infix 4 equalsFlipped as ==.

notEquals' :: forall t e. (AsForeign e, Eq e) => e -> String -> Query SQL t
notEquals' = leftPredicate NotEquals

notEquals'Flipped :: forall t e. (AsForeign e, Eq e) =>
		     String                          ->
		     e                               ->
		     Query SQL t
notEquals'Flipped = flip notEquals'
infix 4 notEquals'Flipped as /=..
infix 4 notEquals'Flipped as !=..

notEquals :: forall t e. (AsForeign e, Eq e) => e -> (t -> e) -> Query Native t
notEquals = rightPredicate NotEquals

notEqualsFlipped :: forall t e. (AsForeign e, Eq e) =>
		    (t -> e)                        ->
		    e                               ->
		    Query Native t
notEqualsFlipped = flip notEquals
infix 4 notEquals' as /=.
infix 4 notEquals' as !=.

lessThan' :: forall t o. (AsForeign o, Ord o) => o -> String -> Query SQL t
lessThan' = leftPredicate LessThan

lessThan'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                           ->
		    o                                ->
		    Query SQL t
lessThan'Flipped = flip lessThan'
infixl 4 lessThan'Flipped as <..

lessThan :: forall t o. (AsForeign o, Ord o) => o -> (t -> o) -> Query Native t
lessThan = rightPredicate LessThan

lessThanFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                        ->
		    o                               ->
		    Query Native t
lessThanFlipped = flip lessThan
infixl 4 lessThanFlipped as <.

lessThanOrEquals' :: forall t o. (AsForeign o, Ord o) =>
		     o                                ->
		     String                           ->
		     Query SQL t
lessThanOrEquals' = leftPredicate LessThanOrEquals

lessThanOrEquals'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                                   ->
		    o                                        ->
		    Query SQL t
lessThanOrEquals'Flipped = flip lessThanOrEquals'
infixl 4 lessThanOrEquals'Flipped as <=..

lessThanOrEquals :: forall t o. (AsForeign o, Ord o) =>
		    o                                ->
		    (t -> o)                         ->
		    Query Native t
lessThanOrEquals = rightPredicate LessThanOrEquals

lessThanOrEqualsFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                                ->
		    o                                       ->
		    Query Native t
lessThanOrEqualsFlipped = flip lessThanOrEquals
infixl 4 lessThanOrEqualsFlipped as <=.

greaterThan' :: forall t o. (AsForeign o, Ord o) => o -> String -> Query SQL t
greaterThan' = leftPredicate GreaterThan

greaterThan'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                              ->
		    o                                   ->
		    Query SQL t
greaterThan'Flipped = flip greaterThan'
infixl 4 greaterThan'Flipped as >..

greaterThan :: forall t o. (AsForeign o, Ord o) => o -> (t -> o) -> Query Native t
greaterThan = rightPredicate GreaterThan

greaterThanFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                           ->
		    o                                  ->
		    Query Native t
greaterThanFlipped = flip greaterThan
infixl 4 greaterThanFlipped as >.

greaterThanOrEquals' :: forall t o. (AsForeign o, Ord o) =>
		     o                                   ->
		     String                              ->
		     Query SQL t
greaterThanOrEquals' = leftPredicate GreaterThanOrEquals

greaterThanOrEquals'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                                      ->
		    o                                           ->
		    Query SQL t
greaterThanOrEquals'Flipped = flip greaterThanOrEquals'
infixl 4 greaterThanOrEquals'Flipped as >=..

greaterThanOrEquals :: forall t o. (AsForeign o, Ord o) =>
		    o                                   ->
		    (t -> o)                            ->
		    Query Native t
greaterThanOrEquals = rightPredicate GreaterThanOrEquals

greaterThanOrEqualsFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                                   ->
		    o                                          ->
		    Query Native t
greaterThanOrEqualsFlipped = flip greaterThanOrEquals
infixl 4 greaterThanOrEqualsFlipped as >=.

sortBy' :: forall datastore t. SortOrder -> String -> Query datastore t
sortBy' order fieldName = Query $ singleton $
	{ clause        : SortBy order
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Left fieldName
	}

sortBy :: forall datastore t. SortOrder -> (t -> Ordering) -> Query datastore t
sortBy order fn = Query $ singleton $
	{ clause        : SortBy order
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Right (fn >>> orderingToInt >>> write)
	}

custom' :: forall t. String -> String -> Query SQL t
custom' name p = Query $ singleton $
	{ clause        : Custom name
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Left p
	}

custom :: forall t. String -> (t -> Boolean) -> Query Native t
custom name fn = Query $ singleton $
	{ clause        : Custom name
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Right (fn >>> write)
	}

class Database d where
	createCollection :: forall e. String   -> Eff (db :: DATABASE | e) Unit
	getCollection    :: forall e t. String ->
			    Eff (db :: DATABASE | e) (Ref (Collection t))
	deleteCollection :: forall e. String   -> Eff (db :: DATABASE | e) Unit

	getWhere :: forall e a t. IsForeign t =>
		    Maybe Pagination          ->
		    Query a t                 ->
		    Ref (Collection t)        ->
		    Eff (db :: DATABASE, ref :: REF | e) (Maybe t)

	getWhere' :: forall e a t. IsForeign t =>
		    Maybe Pagination           ->
		    Query a t                  ->
		    (Ref (Collection t))       ->
		    Eff (db :: DATABASE, ref :: REF | e) (List t)

	countWhere :: forall e a t. IsForeign t =>
		      Query a t                 ->
		      Ref (Collection t)        ->
		      Eff (db :: DATABASE, ref :: REF | e) Int

	insert :: forall e t b. IsForeign t =>
		  t                         ->
		  Ref (Collection t)        ->
		  Eff (db :: DATABASE, ref :: REF | e) b

	insert' :: forall e t b. IsForeign t =>
		   List t                    ->
		   Ref (Collection t)        ->
		   Eff (db :: DATABASE, ref :: REF | e) b

	deleteWhere :: forall e t a b. IsForeign t =>
		       Query a t                   ->
		       Ref (Collection t)          ->
		       Eff (db :: DATABASE, ref :: REF | e) b

module Abstract.Database
	( DATABASE
	, CollectionImpl
	, Collection
	, Pagination
	, limit
	, skip
	, SortOrder
	, asc
	, desc
	, sortOrder
	, getClauseType
	, Clause
	, clause
	, LogicConnector
	, logicConnector
	, Predicate
	, SQL
	, Native
	, Query
	, ordering
	, equals'
	, equals'Flipped
	, (==..)
	, equals
	, equalsFlipped
	, (==.)
	, notEquals'
	, notEquals'Flipped
	, (/=..)
	, (!=..)
	, notEquals
	, notEqualsFlipped
	, (/=.)
	, (!=.)
	, lessThan'
	, lessThan'Flipped
	, (<..)
	, lessThan
	, lessThanFlipped
	, (<.)
	, lessThanOrEquals'
	, lessThanOrEquals'Flipped
	, (<=..)
	, lessThanOrEquals
	, lessThanOrEqualsFlipped
	, (<=.)
	, greaterThan'
	, greaterThan'Flipped
	, (>..)
	, greaterThan
	, greaterThanFlipped
	, (>.)
	, greaterThanOrEquals'
	, greaterThanOrEquals'Flipped
	, (>=..)
	, greaterThanOrEquals
	, greaterThanOrEqualsFlipped
	, (>=.)
	, sortBy'
	, sortBy
	, custom'
	, custom
	, class Database
	, createDatabase
	, deleteDatabase
	, importDatabase
	, exportDatabase
	, openDatabase
	, saveDatabase
	, closeDatabase
	, createCollection
	, getCollection
	, deleteCollection
	, getWhere
	, getWhere'
	, countWhere
	, insert
	, insert'
	, deleteWhere
	) where

import Prelude
	( class Eq
	, class Functor
	, class Ord
	, class Semigroup
	, class Show
	, Ordering(EQ, GT, LT)
	, Unit
	, compare
	, flip
	, map
	, negate
	, show
	, ($)
	, (<>)
	, (==)
	, (<<<)
	, (>>>)
	)

import Control.Alt            (class Alt, (<|>))
import Control.Monad.Eff      (Eff)
import Control.Monad.Eff.Ref  (REF, Ref)
import Data.Foreign           (Foreign)
import Data.Foreign.Class     (class AsForeign, class IsForeign, write)
import Data.Foreign.Undefined (writeUndefined)
import Data.Either            (Either(Left, Right))
import Data.List              (List, singleton, uncons)
import Data.Maybe             (Maybe(Just, Nothing))
import Data.Monoid            (class Monoid, mempty)
import Unsafe.Coerce          (unsafeCoerce)

foreign import data DATABASE       :: !
foreign import data CollectionImpl :: *

type Collection t = { collectionImpl :: CollectionImpl }

newtype Pagination = Pagination
	{ skip   :: Maybe Int
	, limit  :: Maybe Int
	}

instance showPagination :: Show Pagination where
	show (Pagination p) = "(Pagination {"
		<> " skip: "   <> show p.skip
		<> ", limit: " <> show p.limit
		<> " })"

instance eqPagination :: Eq Pagination where
	eq p1 p2 = show p1 == show p2

instance ordPagination :: Ord Pagination where
	compare p1 p2 = compare (show p1) (show p2)

instance semigroupPagination :: Semigroup Pagination where
	append (Pagination p1) (Pagination p2) = Pagination
		{ skip: p2.skip     <|> p1.skip   <|> Nothing
		, limit : p2.limit  <|> p1.limit  <|> Nothing
		}

defPagination :: { skip :: Maybe Int, limit :: Maybe Int }
defPagination =
	{ skip : Nothing
	, limit: Nothing
	}

instance monoidPagination :: Monoid Pagination where
	mempty = Pagination defPagination

limit :: Int -> Maybe Pagination
limit l = Just $ Pagination defPagination { limit = Just l }

skip :: Int -> Maybe Pagination
skip o = Just $ Pagination defPagination { skip = Just o }

data SortOrder = Ascending | Descending

instance showSortOrder :: Show SortOrder where
	show Ascending  = "Ascending"
	show Descending = "Descending"

instance eqSortOrder :: Eq SortOrder where
	eq Ascending  Ascending  = true
	eq Descending Descending = true
	eq _          _          = false

instance ordSortOrder :: Ord SortOrder where
	compare Descending Ascending  = LT
	compare Ascending  Descending = GT
	compare _          _          = EQ

asc :: SortOrder
asc = Ascending

desc :: SortOrder
desc = Descending

sortOrder:: { asc :: SortOrder, desc :: SortOrder }
sortOrder =
	{ asc : Ascending
	, desc: Descending
	}

data Clause = Equals
	    | NotEquals
	    | LessThan
	    | LessThanOrEquals
	    | GreaterThan
	    | GreaterThanOrEquals
	    | SortBy SortOrder
	    | Custom String -- ^ The name of the custom clause.
	    | Negate Clause

instance showClause :: Show Clause where
	show Equals              = "Equals"
	show NotEquals           = "NotEquals"
	show LessThan            = "LessThan"
	show LessThanOrEquals    = "LessThanOrEquals"
	show GreaterThan         = "GreaterThan"
	show GreaterThanOrEquals = "GreaterThanOrEquals"
	show (SortBy s)          = "SortBy (" <> show s <> ")"
	show (Custom c)          = "Custom (" <> show c <> ")"
	show (Negate c)          = "Negate (" <> show c <> ")"

instance eqClause :: Eq Clause where
	eq c1 c2 = show c1 == show c2

getClauseType :: Clause -> String
getClauseType Equals              = "Equals"
getClauseType NotEquals           = "NotEquals"
getClauseType LessThan            = "LessThan"
getClauseType LessThanOrEquals    = "LessThanOrEquals"
getClauseType GreaterThan         = "GreaterThan"
getClauseType GreaterThanOrEquals = "GreaterThanOrEquals"
getClauseType (SortBy _)          = "SortBy"
getClauseType (Custom _)          = "Custom"
getClauseType (Negate _)          = "Negate"

clause :: { equals              :: String
	  , notEquals           :: String
	  , lessThan            :: String
	  , lessThanOrEquals    :: String
	  , greaterThan         :: String
	  , greaterThanOrEquals :: String
	  , sortBy              :: String
	  , custom              :: String
	  , negate              :: String
	  }
clause =
	{ equals             : getClauseType Equals
	, notEquals          : getClauseType NotEquals
	, lessThan           : getClauseType LessThan
	, lessThanOrEquals   : getClauseType LessThanOrEquals
	, greaterThan        : getClauseType GreaterThan
	, greaterThanOrEquals: getClauseType GreaterThanOrEquals
	, sortBy             : getClauseType $ SortBy desc
	, custom             : getClauseType $ Custom mempty
	, negate             : getClauseType $ Negate Equals
	}

data LogicConnector = And | Or

logicConnector :: { and :: LogicConnector, or :: LogicConnector }
logicConnector =
	{ and: And
	, or : Or
	}

instance showLogicConnector :: Show LogicConnector where
	show And = "And"
	show Or  = "Or"

instance eqLogicConnector :: Eq LogicConnector where
	eq And And = true
	eq Or  Or  = true
	eq _   _   = false

type Predicate t =
	{ clause         :: Clause
	, logicConnector :: LogicConnector
	, clauseValue    :: Foreign
	, predicate      :: Either String (t -> Foreign)
	}

showPredicate :: forall t. Predicate t -> String
showPredicate p = "({"
	<> " clause: "          <> show p.clause
	<> ", logicConnector: " <> show p.logicConnector
	<> ", clauseValue: "    <> "(IsForeign a)"
	<> ", predicate: "      <> "(t -> (IsForeign a))"
	<> " })"

data SQL
data Native

data Query datastore t = Query (List (Predicate t))

instance showQuery :: Show (Query datastore t) where
	show (Query l) =
		"(Query (datastore) " <> show (map showPredicate l) <> ")"

instance semigroupQuery :: Semigroup (Query datastore t) where
	append (Query l1) (Query l2) = Query (l1 <> l2)

instance monoidQuery :: Monoid (Query datastore t) where
	mempty = Query mempty

instance functorQuery :: Functor (Query datastore) where
	map _ q = unsafeCoerce q -- Father, forgive me.

instance altQuery :: Alt (Query datastore) where
	alt (Query l1) (Query l2) =
		case uncons l2 of
			Just { head, tail } ->
				Query (l1 <> connectorToOr head <> tail)
			Nothing             -> Query l1
		where
			connectorToOr = singleton <<< _ { logicConnector = Or }

orderingToInt :: Ordering -> Int
orderingToInt LT = -1
orderingToInt EQ = 0
orderingToInt GT = 1

ordering :: { lt :: Int, eq :: Int, gt :: Int }
ordering =
	{ lt: orderingToInt LT
	, eq: orderingToInt EQ
	, gt: orderingToInt GT
	}

leftPredicate :: forall t a datastore. (AsForeign a) =>
		 Clause                              ->
		 a                                   ->
		 String                              ->
		 Query datastore t
leftPredicate clause_ clauseValue fieldName = Query $ singleton $
	{ clause        : clause_
	, logicConnector: And
	, clauseValue   : write clauseValue
	, predicate     : Left fieldName
	}

rightPredicate :: forall t a datastore. (AsForeign a) =>
		  Clause                              ->
		  a                                   ->
		  (t -> a)                            ->
		  Query datastore t
rightPredicate clause_ clauseValue fn = Query $ singleton $
	{ clause        : clause_
	, logicConnector: And
	, clauseValue   : write clauseValue
	, predicate     : Right (fn >>> write)
	}

equals' :: forall t e. (AsForeign e, Eq e) => e -> String -> Query SQL t
equals' = leftPredicate Equals

equals'Flipped :: forall t e. (AsForeign e, Eq e) =>
		  String                          ->
		  e                               ->
		  Query SQL t
equals'Flipped = flip equals'
infix 4 equals'Flipped as ==..

equals :: forall t e. (AsForeign e, Eq e) => e -> (t -> e) -> Query Native t
equals = rightPredicate Equals

equalsFlipped :: forall t e. (AsForeign e, Eq e) =>
		 (t -> e)                        ->
		 e                               ->
		 Query Native t
equalsFlipped = flip equals
infix 4 equalsFlipped as ==.

notEquals' :: forall t e. (AsForeign e, Eq e) => e -> String -> Query SQL t
notEquals' = leftPredicate NotEquals

notEquals'Flipped :: forall t e. (AsForeign e, Eq e) =>
		     String                          ->
		     e                               ->
		     Query SQL t
notEquals'Flipped = flip notEquals'
infix 4 notEquals'Flipped as /=..
infix 4 notEquals'Flipped as !=..

notEquals :: forall t e. (AsForeign e, Eq e) => e -> (t -> e) -> Query Native t
notEquals = rightPredicate NotEquals

notEqualsFlipped :: forall t e. (AsForeign e, Eq e) =>
		    (t -> e)                        ->
		    e                               ->
		    Query Native t
notEqualsFlipped = flip notEquals
infix 4 notEquals' as /=.
infix 4 notEquals' as !=.

lessThan' :: forall t o. (AsForeign o, Ord o) => o -> String -> Query SQL t
lessThan' = leftPredicate LessThan

lessThan'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                           ->
		    o                                ->
		    Query SQL t
lessThan'Flipped = flip lessThan'
infixl 4 lessThan'Flipped as <..

lessThan :: forall t o. (AsForeign o, Ord o) => o -> (t -> o) -> Query Native t
lessThan = rightPredicate LessThan

lessThanFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                        ->
		    o                               ->
		    Query Native t
lessThanFlipped = flip lessThan
infixl 4 lessThanFlipped as <.

lessThanOrEquals' :: forall t o. (AsForeign o, Ord o) =>
		     o                                ->
		     String                           ->
		     Query SQL t
lessThanOrEquals' = leftPredicate LessThanOrEquals

lessThanOrEquals'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                                   ->
		    o                                        ->
		    Query SQL t
lessThanOrEquals'Flipped = flip lessThanOrEquals'
infixl 4 lessThanOrEquals'Flipped as <=..

lessThanOrEquals :: forall t o. (AsForeign o, Ord o) =>
		    o                                ->
		    (t -> o)                         ->
		    Query Native t
lessThanOrEquals = rightPredicate LessThanOrEquals

lessThanOrEqualsFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                                ->
		    o                                       ->
		    Query Native t
lessThanOrEqualsFlipped = flip lessThanOrEquals
infixl 4 lessThanOrEqualsFlipped as <=.

greaterThan' :: forall t o. (AsForeign o, Ord o) => o -> String -> Query SQL t
greaterThan' = leftPredicate GreaterThan

greaterThan'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                              ->
		    o                                   ->
		    Query SQL t
greaterThan'Flipped = flip greaterThan'
infixl 4 greaterThan'Flipped as >..

greaterThan :: forall t o. (AsForeign o, Ord o) => o -> (t -> o) -> Query Native t
greaterThan = rightPredicate GreaterThan

greaterThanFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                           ->
		    o                                  ->
		    Query Native t
greaterThanFlipped = flip greaterThan
infixl 4 greaterThanFlipped as >.

greaterThanOrEquals' :: forall t o. (AsForeign o, Ord o) =>
		     o                                   ->
		     String                              ->
		     Query SQL t
greaterThanOrEquals' = leftPredicate GreaterThanOrEquals

greaterThanOrEquals'Flipped :: forall t o. (AsForeign o, Ord o) =>
		    String                                      ->
		    o                                           ->
		    Query SQL t
greaterThanOrEquals'Flipped = flip greaterThanOrEquals'
infixl 4 greaterThanOrEquals'Flipped as >=..

greaterThanOrEquals :: forall t o. (AsForeign o, Ord o) =>
		    o                                   ->
		    (t -> o)                            ->
		    Query Native t
greaterThanOrEquals = rightPredicate GreaterThanOrEquals

greaterThanOrEqualsFlipped :: forall t o. (AsForeign o, Ord o) =>
		    (t -> o)                                   ->
		    o                                          ->
		    Query Native t
greaterThanOrEqualsFlipped = flip greaterThanOrEquals
infixl 4 greaterThanOrEqualsFlipped as >=.

sortBy' :: forall datastore t. SortOrder -> String -> Query datastore t
sortBy' order fieldName = Query $ singleton $
	{ clause        : SortBy order
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Left fieldName
	}

sortBy :: forall datastore t. SortOrder -> (t -> Ordering) -> Query datastore t
sortBy order fn = Query $ singleton $
	{ clause        : SortBy order
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Right (fn >>> orderingToInt >>> write)
	}

custom' :: forall t. String -> String -> Query SQL t
custom' name p = Query $ singleton $
	{ clause        : Custom name
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Left p
	}

custom :: forall t. String -> (t -> Boolean) -> Query Native t
custom name fn = Query $ singleton $
	{ clause        : Custom name
	, logicConnector: And
	, clauseValue   : writeUndefined
	, predicate     : Right (fn >>> write)
	}

class Database d where
	createDatabase :: forall e. String  -> Eff (db :: DATABASE | e) Unit
	deleteDatabase :: forall e. String  -> Eff (db :: DATABASE | e) Unit
	importDatabase :: forall e. Foreign -> Eff (db :: DATABASE | e) Unit
	exportDatabase :: forall e. Eff (db :: DATABASE | e) Foreign
	openDatabase   :: forall e. String  -> Eff (db :: DATABASE | e) Unit
	saveDatabase   :: forall e. String  -> Eff (db :: DATABASE | e) Unit
	closeDatabase  :: forall e. String  -> Eff (db :: DATABASE | e) Unit

	createCollection :: forall e. String   -> Eff (db :: DATABASE | e) Unit
	getCollection    :: forall e t. String ->
			    Eff (db :: DATABASE | e) (Ref (Collection t))
	deleteCollection :: forall e. String   -> Eff (db :: DATABASE | e) Unit

	getWhere :: forall e a t. IsForeign t =>
		    Maybe Pagination          ->
		    Query a t                 ->
		    Ref (Collection t)        ->
		    Eff (db :: DATABASE, ref :: REF | e) (Maybe t)

	getWhere' :: forall e a t. IsForeign t =>
		    Maybe Pagination           ->
		    Query a t                  ->
		    (Ref (Collection t))       ->
		    Eff (db :: DATABASE, ref :: REF | e) (List t)

	countWhere :: forall e a t. IsForeign t =>
		      Query a t                 ->
		      Ref (Collection t)        ->
		      Eff (db :: DATABASE, ref :: REF | e) Int

	insert :: forall e t b. IsForeign t =>
		  t                         ->
		  Ref (Collection t)        ->
		  Eff (db :: DATABASE, ref :: REF | e) b

	insert' :: forall e t b. IsForeign t =>
		   List t                    ->
		   Ref (Collection t)        ->
		   Eff (db :: DATABASE, ref :: REF | e) b

	deleteWhere :: forall e t a b. IsForeign t =>
		       Query a t                   ->
		       Ref (Collection t)          ->
		       Eff (db :: DATABASE, ref :: REF | e) b


Reorder code to define types (as late as possible) before using them. Reorder exports to match code.


Dates are strings, too

Dates are strings, too

Newtonsoft.Json has its own token type for strings that look like
dates, but we don't handle dates yet.

Original commit b987ca20f750756d360031db947cca67c67fc4c9

module CSharp
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude
import Types

import Data.Array (concatMap)
import Data.Char (toCharCode)
import Data.Char.Unicode (GeneralCategory(..), generalCategory, isLetter, isPrint)
import Data.Foldable (find, for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe, isNothing)
import Data.Set (Set)
import Data.Set as S
import Data.String as Str
import Data.String.Util (capitalize, camelCase, intToHex)
import Data.Tuple (Tuple(..))
import Partial.Unsafe (unsafePartial)

data CSInfo = CSInfo { classNames ::  Map Int String, unionNames :: Map (Set IRType) String, unions :: List (Set IRType) }

type CSDoc = Doc CSInfo

forbiddenNames :: Array String
forbiddenNames = [ "Converter", "JsonConverter", "Type" ]

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , extension: "cs"
    , render: renderGraphToCSharp
    }

renderGraphToCSharp :: IRGraph -> String
renderGraphToCSharp graph =
    let classes = classesInGraph graph
        classNames = transformNames nameForClass nextNameToTry (S.fromFoldable forbiddenNames) classes
        unions = L.fromFoldable $ filterTypes unionPredicate graph
        unionNames = transformNames (unionName classNames graph) nextNameToTry (S.fromFoldable $ M.values classNames) $ map (\s -> Tuple s s) unions
    in
        runDoc csharpDoc graph (CSInfo { classNames, unionNames, unions })
    where
        unionPredicate =
            case _ of
            IRUnion s ->
                if isNothing $ nullableFromSet s then
                    Just s
                else
                    Nothing
            _ -> Nothing
        nameForClass (IRClassData { names }) =
            csNameStyle $ combineNames names
        nextNameToTry s =
            "Other" <> s

unionName :: Map Int String -> IRGraph -> Set IRType -> String
unionName classNames graph s =
    "OneOf" <> (csNameStyle $ intercalate "_" $ map (typeNameForUnion classNames graph) $ L.sort $ L.fromFoldable s)

getClassNames :: CSDoc (Map Int String)
getClassNames = do
    CSInfo { classNames } <- getRendererInfo
    pure classNames

getUnions :: CSDoc (List (Set IRType))
getUnions = do
    CSInfo { unions } <- getRendererInfo
    pure unions

getUnionNames :: CSDoc (Map (Set IRType) String)
getUnionNames = do
    CSInfo { unionNames } <- getRendererInfo
    pure unionNames

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || (generalCategory c == Just LetterNumber)

isStartCharacter :: Char -> Boolean
isStartCharacter c =
    isLetterCharacter c || c == '_'

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    case generalCategory c of
    Nothing -> false
    Just DecimalNumber -> true
    Just ConnectorPunctuation -> true
    Just NonSpacingMark -> true
    Just SpacingCombiningMark -> true
    Just Format -> true
    _ -> isLetterCharacter c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    -- FIXME: use the type to infer a name?
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

stringify :: String -> String
stringify str =
    "\"" <> (Str.fromCharArray $ concatMap charRep $ Str.toCharArray str) <> "\""
    where
        charRep c =
            case c of
            '\\' -> ['\\', '\\']
            '\"' -> ['\\', '\"']
            '\n' -> ['\\', 'n']
            '\t' -> ['\\', 't']
            _ ->
                if isPrint c then
                    [c]
                else
                    let i = toCharCode c
                    in
                        if i <= 0xffff then
                            Str.toCharArray $ "\\u" <> intToHex 4 i
                        else
                            Str.toCharArray $ "\\U" <> intToHex 8 i

nullableFromSet :: Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set IRType -> CSDoc String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> do
        rendered <- renderTypeToCSharp x
        pure if isValueType x then rendered <> "?" else rendered
    Nothing -> lookupUnionName s

lookupName :: forall a. Ord a => a -> Map a String -> String
lookupName original nameMap =
    fromMaybe "NAME_NOT_PROCESSED" $ M.lookup original nameMap

lookupClassName :: Int -> CSDoc String
lookupClassName i = do
    classNames <- getClassNames
    pure $ lookupName i classNames

lookupUnionName :: Set IRType -> CSDoc String
lookupUnionName s = do
    unionNames <- getUnionNames
    pure $ lookupName s unionNames

renderTypeToCSharp :: IRType -> CSDoc String
renderTypeToCSharp = case _ of
    IRNothing -> pure "object"
    IRNull -> pure "object"
    IRInteger -> pure "int"
    IRDouble -> pure "double"
    IRBool -> pure "bool"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderTypeToCSharp a
        pure $ rendered <> "[]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderTypeToCSharp t
        pure $ "Dictionary<string, " <> rendered <> ">"
    IRUnion types -> renderUnionToCSharp types

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize >>> legalizeIdentifier

typeNameForUnion :: Map Int String -> IRGraph -> IRType -> String
typeNameForUnion classNames graph = case _ of
    IRNothing -> "nothing"
    IRNull -> "null"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> typeNameForUnion classNames graph a <> "_array"
    IRClass i ->
        let IRClassData { names } = getClassFromGraph graph i
        in
            combineNames names
    IRMap t -> typeNameForUnion classNames graph t <> "_map"
    IRUnion _ -> "union"

csharpDoc :: CSDoc Unit
csharpDoc = do
    lines """// To parse this JSON data, add NuGet 'Newtonsoft.Json' then do:
             //
             //   var data = QuickType.Converter.FromJson(jsonString);
             //
             namespace QuickType
             {"""
    blank
    indent do
        lines """using System;
                 using System.Net;
                 using System.Collections.Generic;

                 using Newtonsoft.Json;"""
        blank
        renderJsonConverter
        blank
        classes <- getClasses
        for_ classes \(Tuple i cd) -> do
            className <- lookupClassName i
            renderCSharpClass cd className
            blank
        unions <- getUnions
        for_ unions \types -> do
            renderCSharpUnion types
            blank
    lines "}"

stringIfTrue :: Boolean -> String -> String
stringIfTrue true s = s
stringIfTrue false _ = ""

renderJsonConverter :: CSDoc Unit
renderJsonConverter = do
    unionNames <- getUnionNames
    let haveUnions = not $ M.isEmpty unionNames
    let names = M.values unionNames
    lines $ "class Converter" <> stringIfTrue haveUnions " : JsonConverter" <> " {"
    indent do
        IRGraph { toplevel } <- getGraph
        toplevelType <- renderTypeToCSharp toplevel
        lines "// Loading helpers"
        let converterParam = stringIfTrue haveUnions ", new Converter()"
        lines
            $ "public static "
            <> toplevelType
            <> " FromJson(string json) => JsonConvert.DeserializeObject<"
            <> toplevelType
            <> ">(json"
            <> converterParam
            <> ");"

        when haveUnions do
            blank
            lines "public override bool CanConvert(Type t) {"
            indent $ lines $ "return " <> intercalate " || " (map (\n -> "t == typeof(" <> n <> ")") names) <> ";"
            lines "}"
            blank
            lines "public override object ReadJson(JsonReader reader, Type t, object existingValue, JsonSerializer serializer) {"
            indent do
                -- FIXME: call the constructor via reflection?
                for_ names \name -> do
                    lines $ "if (t == typeof(" <> name <> "))"
                    indent $ lines $ "return new " <> name <> "(reader, serializer);"
                lines "throw new Exception(\"Unknown type\");"
            lines "}"
            blank
            lines "public override void WriteJson(JsonWriter writer, object value, JsonSerializer serializer) {"
            indent $ lines "throw new NotImplementedException();"
            lines "}"
            blank
            lines "public override bool CanWrite { get { return false; } }"
    lines "}"

tokenCase :: String -> CSDoc Unit
tokenCase tokenType =
    lines $ "case JsonToken." <> tokenType <> ":"

renderNullDeserializer :: Set IRType -> CSDoc Unit
renderNullDeserializer types =
    when (S.member IRNull types) do
        tokenCase "Null"
        indent do
            lines "break;"

unionFieldName :: IRType -> CSDoc String
unionFieldName t = do
    classNames <- getClassNames
    graph <- getGraph
    let typeName = typeNameForUnion classNames graph t
    pure $ csNameStyle typeName

deserialize :: String -> String -> CSDoc Unit
deserialize fieldName typeName = do
    lines $ fieldName <> " = serializer.Deserialize<" <> typeName <> ">(reader);"
    lines "break;"

deserializeType :: IRType -> CSDoc Unit
deserializeType t = do
    fieldName <- unionFieldName t
    renderedType <- renderTypeToCSharp t
    deserialize fieldName renderedType

renderPrimitiveDeserializer :: List String -> IRType -> Set IRType -> CSDoc Unit
renderPrimitiveDeserializer tokenTypes t types =
    when (S.member t types) do
        for_ tokenTypes \tokenType -> do
            tokenCase tokenType
        indent do
            deserializeType t

renderDoubleDeserializer :: Set IRType -> CSDoc Unit
renderDoubleDeserializer types =
    when (S.member IRDouble types) do
        unless (S.member IRInteger types) do
            tokenCase "Integer"
        tokenCase "Float"
        indent do
            deserializeType IRDouble

renderGenericDeserializer :: (IRType -> Boolean) -> String -> Set IRType -> CSDoc Unit
renderGenericDeserializer predicate tokenType types = unsafePartial $
    case find predicate types of
    Nothing -> pure unit
    Just t -> do
        tokenCase tokenType
        indent do
            deserializeType t

renderCSharpUnion :: Set IRType -> CSDoc Unit
renderCSharpUnion allTypes = do
    name <- lookupUnionName allTypes
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    graph <- getGraph
    line $ words ["struct", name, "{"]
    indent do
        for_ nonNullTypes \t -> do
            typeString <- renderTypeToCSharp $ IRUnion $ S.union (S.singleton t) (S.singleton IRNull)
            field <- unionFieldName t
            lines $ "public " <> typeString <> " " <> field <> ";"
        blank
        lines $ "public " <> name <> "(JsonReader reader, JsonSerializer serializer) {"
        indent do
            for_ (L.fromFoldable nonNullTypes) \field -> do
                fieldName <- unionFieldName field
                lines $ fieldName <> " = null;"
            lines "switch (reader.TokenType) {"
            indent do
                renderNullDeserializer allTypes
                renderPrimitiveDeserializer (L.singleton "Integer") IRInteger allTypes
                renderDoubleDeserializer allTypes
                renderPrimitiveDeserializer (L.singleton "Boolean") IRBool allTypes
                renderPrimitiveDeserializer ("String" : "Date" : L.Nil) IRString allTypes
                renderGenericDeserializer isArray "StartArray" allTypes
                renderGenericDeserializer isClass "StartObject" allTypes
                renderGenericDeserializer isMap "StartObject" allTypes
                lines $ "default: throw new Exception(\"Cannot convert " <> name <> "\");"
            lines "}"
        lines "}"
    lines "}"

renderCSharpClass :: IRClassData -> String -> CSDoc Unit
renderCSharpClass (IRClassData { names, properties }) className = do
    let propertyNames = transformNames csNameStyle ("Other" <> _) (S.singleton className) $ map (\n -> Tuple n n) $ M.keys properties
    line $ words ["class", className]

    lines "{"
    indent do
        for_ (M.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            line do
                string "[JsonProperty("
                string $ stringify pname
                string ")]"
            line do
                string "public "
                rendered <- renderTypeToCSharp ptype
                string rendered
                let csPropName = lookupName pname propertyNames
                words ["", csPropName, "{ get; set; }"]
            blank
    lines "}"

module CSharp
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude
import Types

import Data.Array (concatMap)
import Data.Char (toCharCode)
import Data.Char.Unicode (GeneralCategory(..), generalCategory, isLetter, isPrint)
import Data.Foldable (find, for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe, isNothing)
import Data.Set (Set)
import Data.Set as S
import Data.String as Str
import Data.String.Util (capitalize, camelCase, intToHex)
import Data.Tuple (Tuple(..))
import Partial.Unsafe (unsafePartial)

data CSInfo = CSInfo { classNames ::  Map Int String, unionNames :: Map (Set IRType) String, unions :: List (Set IRType) }

type CSDoc = Doc CSInfo

forbiddenNames :: Array String
forbiddenNames = [ "Converter", "JsonConverter", "Type" ]

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , extension: "cs"
    , render: renderGraphToCSharp
    }

renderGraphToCSharp :: IRGraph -> String
renderGraphToCSharp graph =
    let classes = classesInGraph graph
        classNames = transformNames nameForClass nextNameToTry (S.fromFoldable forbiddenNames) classes
        unions = L.fromFoldable $ filterTypes unionPredicate graph
        unionNames = transformNames (unionName classNames graph) nextNameToTry (S.fromFoldable $ M.values classNames) $ map (\s -> Tuple s s) unions
    in
        runDoc csharpDoc graph (CSInfo { classNames, unionNames, unions })
    where
        unionPredicate =
            case _ of
            IRUnion s ->
                if isNothing $ nullableFromSet s then
                    Just s
                else
                    Nothing
            _ -> Nothing
        nameForClass (IRClassData { names }) =
            csNameStyle $ combineNames names
        nextNameToTry s =
            "Other" <> s

unionName :: Map Int String -> IRGraph -> Set IRType -> String
unionName classNames graph s =
    "OneOf" <> (csNameStyle $ intercalate "_" $ map (typeNameForUnion classNames graph) $ L.sort $ L.fromFoldable s)

getClassNames :: CSDoc (Map Int String)
getClassNames = do
    CSInfo { classNames } <- getRendererInfo
    pure classNames

getUnions :: CSDoc (List (Set IRType))
getUnions = do
    CSInfo { unions } <- getRendererInfo
    pure unions

getUnionNames :: CSDoc (Map (Set IRType) String)
getUnionNames = do
    CSInfo { unionNames } <- getRendererInfo
    pure unionNames

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || (generalCategory c == Just LetterNumber)

isStartCharacter :: Char -> Boolean
isStartCharacter c =
    isLetterCharacter c || c == '_'

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    case generalCategory c of
    Nothing -> false
    Just DecimalNumber -> true
    Just ConnectorPunctuation -> true
    Just NonSpacingMark -> true
    Just SpacingCombiningMark -> true
    Just Format -> true
    _ -> isLetterCharacter c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    -- FIXME: use the type to infer a name?
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

stringify :: String -> String
stringify str =
    "\"" <> (Str.fromCharArray $ concatMap charRep $ Str.toCharArray str) <> "\""
    where
        charRep c =
            case c of
            '\\' -> ['\\', '\\']
            '\"' -> ['\\', '\"']
            '\n' -> ['\\', 'n']
            '\t' -> ['\\', 't']
            _ ->
                if isPrint c then
                    [c]
                else
                    let i = toCharCode c
                    in
                        if i <= 0xffff then
                            Str.toCharArray $ "\\u" <> intToHex 4 i
                        else
                            Str.toCharArray $ "\\U" <> intToHex 8 i

nullableFromSet :: Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set IRType -> CSDoc String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> do
        rendered <- renderTypeToCSharp x
        pure if isValueType x then rendered <> "?" else rendered
    Nothing -> lookupUnionName s

lookupName :: forall a. Ord a => a -> Map a String -> String
lookupName original nameMap =
    fromMaybe "NAME_NOT_PROCESSED" $ M.lookup original nameMap

lookupClassName :: Int -> CSDoc String
lookupClassName i = do
    classNames <- getClassNames
    pure $ lookupName i classNames

lookupUnionName :: Set IRType -> CSDoc String
lookupUnionName s = do
    unionNames <- getUnionNames
    pure $ lookupName s unionNames

renderTypeToCSharp :: IRType -> CSDoc String
renderTypeToCSharp = case _ of
    IRNothing -> pure "object"
    IRNull -> pure "object"
    IRInteger -> pure "int"
    IRDouble -> pure "double"
    IRBool -> pure "bool"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderTypeToCSharp a
        pure $ rendered <> "[]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderTypeToCSharp t
        pure $ "Dictionary<string, " <> rendered <> ">"
    IRUnion types -> renderUnionToCSharp types

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize >>> legalizeIdentifier

typeNameForUnion :: Map Int String -> IRGraph -> IRType -> String
typeNameForUnion classNames graph = case _ of
    IRNothing -> "nothing"
    IRNull -> "null"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> typeNameForUnion classNames graph a <> "_array"
    IRClass i ->
        let IRClassData { names } = getClassFromGraph graph i
        in
            combineNames names
    IRMap t -> typeNameForUnion classNames graph t <> "_map"
    IRUnion _ -> "union"

csharpDoc :: CSDoc Unit
csharpDoc = do
    lines """// To parse this JSON data, add NuGet 'Newtonsoft.Json' then do:
             //
             //   var data = QuickType.Converter.FromJson(jsonString);
             //
             namespace QuickType
             {"""
    blank
    indent do
        lines """using System;
                 using System.Net;
                 using System.Collections.Generic;

                 using Newtonsoft.Json;"""
        blank
        renderJsonConverter
        blank
        classes <- getClasses
        for_ classes \(Tuple i cd) -> do
            className <- lookupClassName i
            renderCSharpClass cd className
            blank
        unions <- getUnions
        for_ unions \types -> do
            renderCSharpUnion types
            blank
    lines "}"

stringIfTrue :: Boolean -> String -> String
stringIfTrue true s = s
stringIfTrue false _ = ""

renderJsonConverter :: CSDoc Unit
renderJsonConverter = do
    unionNames <- getUnionNames
    let haveUnions = not $ M.isEmpty unionNames
    let names = M.values unionNames
    lines $ "class Converter" <> stringIfTrue haveUnions " : JsonConverter" <> " {"
    indent do
        IRGraph { toplevel } <- getGraph
        toplevelType <- renderTypeToCSharp toplevel
        lines "// Loading helpers"
        let converterParam = stringIfTrue haveUnions ", new Converter()"
        lines
            $ "public static "
            <> toplevelType
            <> " FromJson(string json) => JsonConvert.DeserializeObject<"
            <> toplevelType
            <> ">(json"
            <> converterParam
            <> ");"

        when haveUnions do
            blank
            lines "public override bool CanConvert(Type t) {"
            indent $ lines $ "return " <> intercalate " || " (map (\n -> "t == typeof(" <> n <> ")") names) <> ";"
            lines "}"
            blank
            lines "public override object ReadJson(JsonReader reader, Type t, object existingValue, JsonSerializer serializer) {"
            indent do
                -- FIXME: call the constructor via reflection?
                for_ names \name -> do
                    lines $ "if (t == typeof(" <> name <> "))"
                    indent $ lines $ "return new " <> name <> "(reader, serializer);"
                lines "throw new Exception(\"Unknown type\");"
            lines "}"
            blank
            lines "public override void WriteJson(JsonWriter writer, object value, JsonSerializer serializer) {"
            indent $ lines "throw new NotImplementedException();"
            lines "}"
            blank
            lines "public override bool CanWrite { get { return false; } }"
    lines "}"

tokenCase :: String -> CSDoc Unit
tokenCase tokenType =
    lines $ "case JsonToken." <> tokenType <> ":"

renderNullDeserializer :: Set IRType -> CSDoc Unit
renderNullDeserializer types =
    when (S.member IRNull types) do
        tokenCase "Null"
        indent do
            lines "break;"

unionFieldName :: IRType -> CSDoc String
unionFieldName t = do
    classNames <- getClassNames
    graph <- getGraph
    let typeName = typeNameForUnion classNames graph t
    pure $ csNameStyle typeName

deserialize :: String -> String -> CSDoc Unit
deserialize fieldName typeName = do
    lines $ fieldName <> " = serializer.Deserialize<" <> typeName <> ">(reader);"
    lines "break;"

deserializeType :: IRType -> CSDoc Unit
deserializeType t = do
    fieldName <- unionFieldName t
    renderedType <- renderTypeToCSharp t
    deserialize fieldName renderedType

renderPrimitiveDeserializer :: String -> IRType -> Set IRType -> CSDoc Unit
renderPrimitiveDeserializer tokenType t types =
    when (S.member t types) do
        tokenCase tokenType
        indent do
            deserializeType t

renderDoubleDeserializer :: Set IRType -> CSDoc Unit
renderDoubleDeserializer types =
    when (S.member IRDouble types) do
        unless (S.member IRInteger types) do
            tokenCase "Integer"
        tokenCase "Float"
        indent do
            deserializeType IRDouble

renderGenericDeserializer :: (IRType -> Boolean) -> String -> Set IRType -> CSDoc Unit
renderGenericDeserializer predicate tokenType types = unsafePartial $
    case find predicate types of
    Nothing -> pure unit
    Just t -> do
        tokenCase tokenType
        indent do
            deserializeType t

renderCSharpUnion :: Set IRType -> CSDoc Unit
renderCSharpUnion allTypes = do
    name <- lookupUnionName allTypes
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    graph <- getGraph
    line $ words ["struct", name, "{"]
    indent do
        for_ nonNullTypes \t -> do
            typeString <- renderTypeToCSharp $ IRUnion $ S.union (S.singleton t) (S.singleton IRNull)
            field <- unionFieldName t
            lines $ "public " <> typeString <> " " <> field <> ";"
        blank
        lines $ "public " <> name <> "(JsonReader reader, JsonSerializer serializer) {"
        indent do
            for_ (L.fromFoldable nonNullTypes) \field -> do
                fieldName <- unionFieldName field
                lines $ fieldName <> " = null;"
            lines "switch (reader.TokenType) {"
            indent do
                renderNullDeserializer allTypes
                renderPrimitiveDeserializer "Integer" IRInteger allTypes
                renderDoubleDeserializer allTypes
                renderPrimitiveDeserializer "Boolean" IRBool allTypes
                renderPrimitiveDeserializer "String" IRString allTypes
                renderGenericDeserializer isArray "StartArray" allTypes
                renderGenericDeserializer isClass "StartObject" allTypes
                renderGenericDeserializer isMap "StartObject" allTypes
                lines $ "default: throw new Exception(\"Cannot convert " <> name <> "\");"
            lines "}"
        lines "}"
    lines "}"

renderCSharpClass :: IRClassData -> String -> CSDoc Unit
renderCSharpClass (IRClassData { names, properties }) className = do
    let propertyNames = transformNames csNameStyle ("Other" <> _) (S.singleton className) $ map (\n -> Tuple n n) $ M.keys properties
    line $ words ["class", className]

    lines "{"
    indent do
        for_ (M.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            line do
                string "[JsonProperty("
                string $ stringify pname
                string ")]"
            line do
                string "public "
                rendered <- renderTypeToCSharp ptype
                string rendered
                let csPropName = lookupName pname propertyNames
                words ["", csPropName, "{ get; set; }"]
            blank
    lines "}"


Better gofmt compliance

Better gofmt compliance

Original commit 35f5c0c6bc23799116e43f6d721452e34f7c0a12

module Golang
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Array as A
import Data.Char.Unicode (isDigit, isLetter)
import Data.Foldable (for_, intercalate, foldl)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Set (Set)
import Data.Set as S
import Data.String as Str
import Data.String.Util (capitalize, camelCase, stringEscape)
import Data.Tuple (Tuple(..))
import Utils (mapM, removeElement)

renderer :: Renderer
renderer =
    { name: "Go"
    , aceMode: "golang"
    , extension: "go"
    , doc: golangDoc
    , transforms:
        { nameForClass
        , unionName: Just unionName
        , unionPredicate: Just unionPredicate
        , nextName: \s -> "Other" <> s
        , forbiddenNames: []
        }
    }

unionPredicate :: IRType -> Maybe (Set IRType)
unionPredicate = case _ of
    IRUnion ur ->
        let s = unionToSet ur
        in case nullableFromSet s of
            Nothing -> Just s
            _ -> Nothing
    _ -> Nothing

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = goNameStyle $ combineNames names

unionName :: L.List String -> String
unionName s =
    L.sort s
    <#> goNameStyle
    # intercalate "Or"

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType IRString = true
isValueType (IRClass _) = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || c == '_'

isStartCharacter :: Char -> Boolean
isStartCharacter = isLetterCharacter

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    isLetterCharacter c || isDigit c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    -- FIXME: use the type to infer a name?
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

noComment :: String -> Doc { rendered :: String, comment :: Maybe String }
noComment rendered =
    pure { rendered, comment: Nothing }

renderUnionToGolang :: Set IRType -> Doc { rendered :: String, comment :: Maybe String }
renderUnionToGolang s =
    case nullableFromSet s of
    Just x -> do
        { rendered, comment } <- renderTypeToGolang x
        pure
            if isValueType x then
                { rendered: "*" <> rendered, comment: Just $ maybe "optional" ("optional "<> _) comment }
            else
                { rendered, comment: Nothing }
    Nothing -> do
        noComment =<< lookupUnionName s

renderTypeToGolang :: IRType -> Doc { rendered :: String, comment :: Maybe String }
renderTypeToGolang = case _ of
    IRNothing -> noComment "interface{}"
    IRNull -> noComment "interface{}"
    IRInteger -> noComment "int64"
    IRDouble -> noComment "float64"
    IRBool -> noComment "bool"
    IRString -> noComment "string"
    IRArray a -> do
        { rendered, comment } <- renderTypeToGolang a
        pure { rendered: "[]" <> rendered, comment: map ("array of " <> _) comment }
    IRClass i -> noComment =<< lookupClassName i
    IRMap t -> do
        { rendered, comment } <- renderTypeToGolang t
        pure { rendered: "map[string]" <> rendered, comment: map ("map to " <> _) comment }
    IRUnion types -> renderUnionToGolang $ unionToSet types

renderComment :: Maybe String -> String
renderComment (Just s) = " /* " <> s <> " */"
renderComment Nothing = ""

goNameStyle :: String -> String
goNameStyle = camelCase >>> capitalize >>> legalizeIdentifier

golangDoc :: Doc Unit
golangDoc = do
    line """// To parse and unparse this JSON data, add this code to your project and do:
//
//    r, err := UnmarshalRoot(bytes)
//    bytes, err = r.Marshal()

package main
"""
    unions <- getUnions
    unless (unions == L.Nil) do
        line "import \"bytes\""
        line "import \"errors\""
    line "import \"encoding/json\""
    blank
    { rendered: renderedToplevel, comment: toplevelComment } <- getTopLevel >>= renderTypeToGolang
    line $ "type Root " <> renderedToplevel <> (renderComment toplevelComment)
    blank
    line """func UnmarshalRoot(data []byte) (Root, error) {
	var r Root
	err := json.Unmarshal(data, &r)
	return r, err
}

func (r *Root) Marshal() ([]byte, error) {
	return json.Marshal(r)
}
"""
    classes <- getClasses
    for_ classes \(Tuple i cls) -> do
        renderGolangType i cls
        blank
    unless (unions == L.Nil) do
        line """func unmarshalUnion(data []byte, pi **int64, pf **float64, pb **bool, ps **string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) (bool, error) {
	if pi != nil {
		*pi = nil
	}
	if pf != nil {
		*pf = nil
	}
	if pb != nil {
		*pb = nil
	}
	if ps != nil {
		*ps = nil
	}

	dec := json.NewDecoder(bytes.NewReader(data))
	dec.UseNumber()
	tok, err := dec.Token()
	if err != nil {
		return false, err
	}

	switch v := tok.(type) {
	case json.Number:
		if pi != nil {
			i, err := v.Int64()
			if err == nil {
				*pi = &i
				return false, nil
			}
		}
		if pf != nil {
			f, err := v.Float64()
			if err == nil {
				*pf = &f
				return false, nil
			}
			return false, errors.New("Unparsable number")
		}
		return false, errors.New("Union does not contain number")
	case float64:
		return false, errors.New("Decoder should not return float64")
	case bool:
		if pb != nil {
			*pb = &v
			return false, nil
		}
		return false, errors.New("Union does not contain bool")
	case string:
		if ps != nil {
			*ps = &v
			return false, nil
		}
		return false, errors.New("Union does not contain string")
	case nil:
		if nullable {
			return false, nil
		}
		return false, errors.New("Union does not contain null")
	case json.Delim:
		if v == '{' {
			if haveObject {
				return true, json.Unmarshal(data, pc)
			}
			if haveMap {
				return false, json.Unmarshal(data, pm)
			}
			return false, errors.New("Union does not contain object")
		}
		if v == '[' {
			if haveArray {
				return false, json.Unmarshal(data, pa)
			}
			return false, errors.New("Union does not contain array")
		}
		return false, errors.New("Cannot handle delimiter")
	}
	return false, errors.New("Cannot unmarshal union")

}

func marshalUnion(pi *int64, pf *float64, pb *bool, ps *string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) ([]byte, error) {
	if pi != nil {
		return json.Marshal(*pi)
	}
	if pf != nil {
		return json.Marshal(*pf)
	}
	if pb != nil {
		return json.Marshal(*pb)
	}
	if ps != nil {
		return json.Marshal(*ps)
	}
	if haveArray {
		return json.Marshal(pa)
	}
	if haveObject {
		return json.Marshal(pc)
	}
	if haveMap {
		return json.Marshal(pm)
	}
	if nullable {
		return json.Marshal(nil)
	}
	return nil, errors.New("Union must not be null")
}"""
    for_ unions \types -> do
        blank
        renderGolangUnion types

pad :: Int -> String -> String
pad n s = s <> Str.fromCharArray (A.replicate (n - (Str.length s)) ' ')

columnize :: List (List String) -> Doc Unit
columnize L.Nil = pure unit
columnize rows@(firstRow : otherRows) =
    let columnWidths = foldl (\m l -> L.zipWith max m $ map Str.length l) (map Str.length firstRow) otherRows
        paddedRows = map (L.zipWith pad columnWidths) rows
    in
        for_ paddedRows \row -> do
            line $ Str.trim $ intercalate " " row

renderStruct :: String -> List (List String) -> Doc Unit
renderStruct name columns = do
    line $ "type " <> name <> " struct {"
    indent do
        columnize columns
    line "}"

renderGolangType :: Int -> IRClassData -> Doc Unit
renderGolangType classIndex (IRClassData { names, properties }) = do
    className <- lookupClassName classIndex
    let propertyNames = transformNames goNameStyle ("Other" <> _) S.empty $ map (\n -> Tuple n n) $ Map.keys properties
    let propsArray = Map.toUnfoldable properties :: List _
    columns <- propsArray # mapM \(Tuple pname ptype) -> do
        let csPropName = lookupName pname propertyNames
        { rendered, comment } <- renderTypeToGolang ptype
        pure $ (csPropName : rendered : ("`json:\"" <> (stringEscape pname) <> "\"`" <> renderComment comment) : L.Nil)
    renderStruct className columns

unionFieldName :: IRType -> Doc String
unionFieldName t = goNameStyle <$> getTypeNameForUnion t

compoundPredicates :: Array (IRType -> Boolean)
compoundPredicates = [isArray, isClass, isMap]

renderGolangUnion :: Set IRType -> Doc Unit
renderGolangUnion allTypes = do
    name <- lookupUnionName allTypes
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    let isNullableString = if isJust emptyOrNull then "true" else "false"
    columns <- (L.fromFoldable nonNullTypes) # mapM \t -> do
        { rendered, comment } <- renderUnionToGolang $ S.union (S.singleton t) (S.singleton IRNull)
        field <- unionFieldName t
        pure $ (field : (rendered <> renderComment comment) : L.Nil)
    renderStruct name columns
    blank
    line $ "func (x *" <> name <> ") UnmarshalJSON(data []byte) error {"
    indent do
        for_ compoundPredicates \p -> maybeAssignNil p
        ifClass \name -> do
            line $ "var c " <> name
        args <- makeArgs primitiveUnmarshalArg compoundUnmarshalArg
        line $ "object, err := unmarshalUnion(data, " <> args <> ", " <> isNullableString <> ")"
        line "if err != nil {"
        indent do
    		line "return err"
        line "}"
        line "if object {"
        ifClass \name -> do
            indent do
                line $ "x." <> name <> " = &c"
        line "}"
        line "return nil"
    line "}"
    blank
    line $ "func (x *" <> name <> ") MarshalJSON() ([]byte, error) {"
    indent do
        args <- makeArgs primitiveMarshalArg compoundMarshalArg
        line $ "return marshalUnion(" <> args <> ", " <> isNullableString <> ")"
    line "}"
    where
        ifClass :: (String -> Doc Unit) -> Doc Unit
        ifClass f =
            let { element } = removeElement isClass allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    f name
                Nothing -> pure unit
        maybeAssignNil p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    line $ "x." <> name <> " = nil"
                Nothing -> pure unit
        makeArgs :: (IRType -> Doc String) -> ((IRType -> Boolean) -> Doc String) -> Doc String
        makeArgs primitive compound = do
            primitiveArgs <- mapM primitive $ L.fromFoldable [IRInteger, IRDouble, IRBool, IRString]
            compoundArgs <- mapM compound $ L.fromFoldable compoundPredicates
            pure $ intercalate ", " $ A.concat [A.fromFoldable primitiveArgs, A.fromFoldable compoundArgs]
        memberArg :: String -> (IRType -> String -> String) -> (IRType -> Boolean) -> Doc String
        memberArg notPresentValue renderPresent p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    pure $ renderPresent t name
                Nothing -> pure notPresentValue
        primitiveUnmarshalArg t =
            memberArg "nil" (\_ n -> "&x." <> n) (eq t)
        compoundUnmarshalArg p =
            memberArg "false, nil" (\t n -> if isClass t then "true, &c" else "true, &x." <> n) p
        primitiveMarshalArg :: IRType -> Doc String
        primitiveMarshalArg t =
            memberArg "nil" (\_ n -> "x." <> n) (eq t)
        compoundMarshalArg :: (IRType -> Boolean) -> Doc String
        compoundMarshalArg p =
            memberArg "false, nil" (\t n -> "x." <> n <> " != nil, x." <> n) p

module Golang
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Array as A
import Data.Char.Unicode (isDigit, isLetter)
import Data.Foldable (for_, intercalate)
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Set (Set)
import Data.Set as S
import Data.String as Str
import Data.String.Util (capitalize, camelCase, stringEscape)
import Data.Tuple (Tuple(..))
import Utils (mapM, removeElement)

renderer :: Renderer
renderer =
    { name: "Go"
    , aceMode: "golang"
    , extension: "go"
    , doc: golangDoc
    , transforms:
        { nameForClass
        , unionName: Just unionName
        , unionPredicate: Just unionPredicate
        , nextName: \s -> "Other" <> s
        , forbiddenNames: []
        }
    }

unionPredicate :: IRType -> Maybe (Set IRType)
unionPredicate = case _ of
    IRUnion ur ->
        let s = unionToSet ur
        in case nullableFromSet s of
            Nothing -> Just s
            _ -> Nothing
    _ -> Nothing

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = goNameStyle $ combineNames names

unionName :: L.List String -> String
unionName s =
    L.sort s
    <#> goNameStyle
    # intercalate "Or"

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType IRString = true
isValueType (IRClass _) = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || c == '_'

isStartCharacter :: Char -> Boolean
isStartCharacter = isLetterCharacter

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    isLetterCharacter c || isDigit c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    -- FIXME: use the type to infer a name?
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

noComment :: String -> Doc { rendered :: String, comment :: Maybe String }
noComment rendered =
    pure { rendered, comment: Nothing }

renderUnionToGolang :: Set IRType -> Doc { rendered :: String, comment :: Maybe String }
renderUnionToGolang s =
    case nullableFromSet s of
    Just x -> do
        { rendered, comment } <- renderTypeToGolang x
        pure
            if isValueType x then
                { rendered: "*" <> rendered, comment: Just $ maybe "optional" ("optional "<> _) comment }
            else
                { rendered, comment: Nothing }
    Nothing -> do
        noComment =<< lookupUnionName s

renderTypeToGolang :: IRType -> Doc { rendered :: String, comment :: Maybe String }
renderTypeToGolang = case _ of
    IRNothing -> noComment "interface{}"
    IRNull -> noComment "interface{}"
    IRInteger -> noComment "int64"
    IRDouble -> noComment "float64"
    IRBool -> noComment "bool"
    IRString -> noComment "string"
    IRArray a -> do
        { rendered, comment } <- renderTypeToGolang a
        pure { rendered: "[]" <> rendered, comment: map ("array of " <> _) comment }
    IRClass i -> noComment =<< lookupClassName i
    IRMap t -> do
        { rendered, comment } <- renderTypeToGolang t
        pure { rendered: "map[string]" <> rendered, comment: map ("map to " <> _) comment }
    IRUnion types -> renderUnionToGolang $ unionToSet types

renderComment :: Maybe String -> String
renderComment (Just s) = " /* " <> s <> " */"
renderComment Nothing = ""

goNameStyle :: String -> String
goNameStyle = camelCase >>> capitalize >>> legalizeIdentifier

golangDoc :: Doc Unit
golangDoc = do
    line """// To parse and unparse this JSON data, add this code to your project and do:
//
//    r, err := UnmarshalRoot(bytes)
//    bytes, err = r.Marshal()

package main
"""
    unions <- getUnions
    unless (unions == L.Nil) do
        line "import \"bytes\""
        line "import \"errors\""
    line "import \"encoding/json\""
    blank
    { rendered: renderedToplevel, comment: toplevelComment } <- getTopLevel >>= renderTypeToGolang
    line $ "type Root " <> renderedToplevel <> (renderComment toplevelComment)
    blank
    line """func UnmarshalRoot(data []byte) (Root, error) {
	var r Root
	err := json.Unmarshal(data, &r)
	return r, err
}

func (r *Root) Marshal() ([]byte, error) {
	return json.Marshal(r)
}
"""
    classes <- getClasses
    for_ classes \(Tuple i cls) -> do
        renderGolangType i cls
        blank
    unless (unions == L.Nil) do
        line """func unmarshalUnion(data []byte, pi **int64, pf **float64, pb **bool, ps **string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) (bool, error) {
	if pi != nil {
		*pi = nil
	}
	if pf != nil {
		*pf = nil
	}
	if pb != nil {
		*pb = nil
	}
	if ps != nil {
		*ps = nil
	}

	dec := json.NewDecoder(bytes.NewReader(data))
	dec.UseNumber()
	tok, err := dec.Token()
	if err != nil {
		return false, err
	}

	switch v := tok.(type) {
	case json.Number:
		if pi != nil {
			i, err := v.Int64()
			if err == nil {
				*pi = &i
				return false, nil
			}
		}
		if pf != nil {
			f, err := v.Float64()
			if err == nil {
				*pf = &f
				return false, nil
			}
			return false, errors.New("Unparsable number")
		}
		return false, errors.New("Union does not contain number")
	case float64:
		return false, errors.New("Decoder should not return float64")
	case bool:
		if pb != nil {
			*pb = &v
			return false, nil
		}
		return false, errors.New("Union does not contain bool")
	case string:
		if ps != nil {
			*ps = &v
			return false, nil
		}
		return false, errors.New("Union does not contain string")
	case nil:
		if nullable {
			return false, nil
		}
		return false, errors.New("Union does not contain null")
	case json.Delim:
		if v == '{' {
			if haveObject {
				return true, json.Unmarshal(data, pc)
			}
			if haveMap {
				return false, json.Unmarshal(data, pm)
			}
			return false, errors.New("Union does not contain object")
		}
		if v == '[' {
			if haveArray {
				return false, json.Unmarshal(data, pa)
			}
			return false, errors.New("Union does not contain array")
		}
		return false, errors.New("Cannot handle delimiter")
	}
	return false, errors.New("Cannot unmarshal union")

}

func marshalUnion(pi *int64, pf *float64, pb *bool, ps *string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) ([]byte, error) {
	if pi != nil {
		return json.Marshal(*pi)
	}
	if pf != nil {
		return json.Marshal(*pf)
	}
	if pb != nil {
		return json.Marshal(*pb)
	}
	if ps != nil {
		return json.Marshal(*ps)
	}
	if haveArray {
		return json.Marshal(pa)
	}
	if haveObject {
		return json.Marshal(pc)
	}
	if haveMap {
		return json.Marshal(pm)
	}
	if nullable {
		return json.Marshal(nil)
	}
	return nil, errors.New("Union must not be null")
}"""
    for_ unions \types -> do
        blank
        renderGolangUnion types

renderGolangType :: Int -> IRClassData -> Doc Unit
renderGolangType classIndex (IRClassData { names, properties }) = do
    className <- lookupClassName classIndex
    let propertyNames = transformNames goNameStyle ("Other" <> _) S.empty $ map (\n -> Tuple n n) $ Map.keys properties
    line $ "type " <> className <> " struct {"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            let csPropName = lookupName pname propertyNames
            { rendered, comment } <- renderTypeToGolang ptype
            line $ csPropName <> " " <> rendered <> " `json:\"" <> (stringEscape pname) <> "\"`" <> (renderComment comment)
    line "}"

unionFieldName :: IRType -> Doc String
unionFieldName t = goNameStyle <$> getTypeNameForUnion t

compoundPredicates :: Array (IRType -> Boolean)
compoundPredicates = [isArray, isClass, isMap]

renderGolangUnion :: Set IRType -> Doc Unit
renderGolangUnion allTypes = do
    name <- lookupUnionName allTypes
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    let isNullableString = if isJust emptyOrNull then "true" else "false"
    line $ "type " <> name <> " struct {"
    indent do
        for_ nonNullTypes \t -> do
            { rendered, comment } <- renderUnionToGolang $ S.union (S.singleton t) (S.singleton IRNull)
            field <- unionFieldName t
            line $ field <> " " <> rendered <> (renderComment comment)
    line "}"
    blank
    line $ "func (x *" <> name <> ") UnmarshalJSON(data []byte) error {"
    indent do
        for_ compoundPredicates \p -> maybeAssignNil p
        ifClass \name -> do
            line $ "var c " <> name
        args <- makeArgs primitiveUnmarshalArg compoundUnmarshalArg
        line $ "object, err := unmarshalUnion(data, " <> args <> ", " <> isNullableString <> ")"
        line "if err != nil {"
        indent do
    		line "return err"
        line "}"
        line "if object {"
        ifClass \name -> do
            indent do
                line $ "x." <> name <> " = &c"
        line "}"
        line "return nil"
    line "}"
    blank
    line $ "func (x *" <> name <> ") MarshalJSON() ([]byte, error) {"
    indent do
        args <- makeArgs primitiveMarshalArg compoundMarshalArg
        line $ "return marshalUnion(" <> args <> ", " <> isNullableString <> ")"
    line "}"
    where
        ifClass :: (String -> Doc Unit) -> Doc Unit
        ifClass f =
            let { element } = removeElement isClass allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    f name
                Nothing -> pure unit
        maybeAssignNil p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    line $ "x." <> name <> " = nil"
                Nothing -> pure unit
        makeArgs :: (IRType -> Doc String) -> ((IRType -> Boolean) -> Doc String) -> Doc String
        makeArgs primitive compound = do
            primitiveArgs <- mapM primitive $ L.fromFoldable [IRInteger, IRDouble, IRBool, IRString]
            compoundArgs <- mapM compound $ L.fromFoldable compoundPredicates
            pure $ intercalate ", " $ A.concat [A.fromFoldable primitiveArgs, A.fromFoldable compoundArgs]
        memberArg :: String -> (IRType -> String -> String) -> (IRType -> Boolean) -> Doc String
        memberArg notPresentValue renderPresent p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    pure $ renderPresent t name
                Nothing -> pure notPresentValue
        primitiveUnmarshalArg t =
            memberArg "nil" (\_ n -> "&x." <> n) (eq t)
        compoundUnmarshalArg p =
            memberArg "false, nil" (\t n -> if isClass t then "true, &c" else "true, &x." <> n) p
        primitiveMarshalArg :: IRType -> Doc String
        primitiveMarshalArg t =
            memberArg "nil" (\_ n -> "x." <> n) (eq t)
        compoundMarshalArg :: (IRType -> Boolean) -> Doc String
        compoundMarshalArg p =
            memberArg "false, nil" (\t n -> "x." <> n <> " != nil, x." <> n) p